From 15700b7ef108858b9d99d1f40373a5b9ddc7c332 Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Fri, 3 May 2024 16:10:30 +0000 Subject: [PATCH 01/29] unresolved bathymetry input in grib 2 --- src/programs/create_wam_bathymetry_ETOPO1.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/programs/create_wam_bathymetry_ETOPO1.F90 b/src/programs/create_wam_bathymetry_ETOPO1.F90 index 3451ff106..c4303e358 100644 --- a/src/programs/create_wam_bathymetry_ETOPO1.F90 +++ b/src/programs/create_wam_bathymetry_ETOPO1.F90 @@ -422,8 +422,7 @@ PROGRAM CREATE_BATHY_ETOPO1 ! FOR INTEGRATED PARAMETERS CALL PRESET_WGRIB_TEMPLATE("I",NGRIB_HANDLE_WAM_I,NGRIBV=2,LLCREATE=.true.,NBITSPERVALUE=24) ! FOR SPECTRA -!!! grib 2 spectra not yet implemented !!!! - CALL PRESET_WGRIB_TEMPLATE("S",NGRIB_HANDLE_WAM_S,NGRIBV=1,LLCREATE=.true.,NBITSPERVALUE=12) + CALL PRESET_WGRIB_TEMPLATE("S",NGRIB_HANDLE_WAM_S,NGRIBV=2,LLCREATE=.true.,NBITSPERVALUE=12) DO IP = 0, NPROPAGS WRITE(C1,'(I1)') IP From 75cfac3974bf0c70d0602db1ea17ebfc3f98a82f Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Wed, 26 Jun 2024 14:42:20 +0000 Subject: [PATCH 02/29] add gross error check for alt data --- src/ecwam/mpuserin.F90 | 7 +++++-- src/ecwam/userin.F90 | 12 +++++------- src/ecwam/yowaltas.F90 | 2 ++ 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/src/ecwam/mpuserin.F90 b/src/ecwam/mpuserin.F90 index af05aa0a4..9ac93c25b 100644 --- a/src/ecwam/mpuserin.F90 +++ b/src/ecwam/mpuserin.F90 @@ -44,7 +44,7 @@ SUBROUTINE MPUSERIN USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU USE YOWALTAS , ONLY : NUMALT ,IBUFRSAT ,ALTSDTHRSH,ALTBGTHRSH, & - & HSALTCUT, LALTGRDOUT, LALTPAS, & + & ALTGRTHRSH, HSALTCUT, LALTGRDOUT, LALTPAS, & & XKAPPA2 ,HSCOEFCOR,HSCONSCOR ,LALTCOR ,LALTLRGR, & & LODBRALT ,CSATNAME USE YOWCOUP , ONLY : LWCOU ,KCOUSTEP ,LWFLUX ,LWVFLX_SNL, & @@ -209,7 +209,7 @@ SUBROUTINE MPUSERIN & IBUFRSAT, CSATNAME, & & SWAMPWIND, SWAMPWIND2, SWAMPCIFR, SWAMPCITH, & & DTNEWWIND, LTURN90, & - & LALTLRGR, HSCOEFCOR, HSCONSCOR,ALTSDTHRSH,ALTBGTHRSH,HSALTCUT, & + & LALTLRGR, HSCOEFCOR, HSCONSCOR,ALTSDTHRSH,ALTBGTHRSH,ALTGRTHRSH,HSALTCUT, & & ISTREAM, NLOCGRB, IREFDATE, & & NCONSENSUS, NDWD, NMFR, NNCEP, NUKM, & & LGUST, LADEN, LRELWIND, LALTGRDOUT, LSUBGRID, LALTPAS, & @@ -421,6 +421,7 @@ SUBROUTINE MPUSERIN ! ALTIMETER WAVE HEIGHTS. ! ALTSDTHRSH:THRESHOLD FOR SUSPICIOUS DATA (SEE GRFIELD). ! ALTBGTHRSH:THRESHOLD FOR BACKGROUND CHECK (SEE GRFIELD). +! ALTGRTHRSH:THRESHOLD FOR GROSS ERROR CHECK (SEE GRFIELD). ! HSALTCUT: USER INPUT OF THE MINIMUM WAVE HEIGHT ALLOWED IN ALTAS ! (SEE GRFIELD). ! ISTREAM: STREAM NUMBER USED WHEN GRIBBING THE DATA @@ -616,6 +617,8 @@ SUBROUTINE MPUSERIN HSCONSCOR(ISAT) = 0.0_JWRB ALTBGTHRSH(ISAT) = 1.5_JWRB + ALTGRTHRSH(ISAT) = 3.0_JWRB + ! if no value is provided in the namelist ALTSDTHRSH will ! be set in grfield. ALTSDTHRSH(ISAT) = -1.0_JWRB diff --git a/src/ecwam/userin.F90 b/src/ecwam/userin.F90 index 8624376ff..825cfd19b 100644 --- a/src/ecwam/userin.F90 +++ b/src/ecwam/userin.F90 @@ -73,7 +73,7 @@ SUBROUTINE USERIN (IFORCA, LWCUR) USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU USE YOWALTAS , ONLY : NUMALT ,IBUFRSAT ,ALTSDTHRSH,ALTBGTHRSH, & - & HSALTCUT, LALTGRDOUT, LALTPAS, LALTPASSIV, & + & ALTGRTHRSH,HSALTCUT, LALTGRDOUT, LALTPAS, LALTPASSIV, & & XKAPPA2 ,HSCOEFCOR,HSCONSCOR ,LALTCOR ,LALTLRGR, & & LODBRALT ,CSATNAME USE YOWCOUP , ONLY : LWCOU ,LWCOU2W ,LWCOURNW, LWCOUAST, & @@ -1044,14 +1044,12 @@ SUBROUTINE USERIN (IFORCA, LWCUR) WRITE(IU06,*) ' THE DATA WILL BE CORRECTED ' WRITE(IU06,*) ' ACCORDING TO THE MODEL SEA STATE.' ENDIF - WRITE(IU06,*) ' THE THRESHOLD FOR BACKGROUND CHECK IS ', & - & ALTBGTHRSH(ISAT) + WRITE(IU06,*) ' THE THRESHOLD FOR BACKGROUND CHECK IS ', ALTBGTHRSH(ISAT) + WRITE(IU06,*) ' THE THRESHOLD FOR GROSS ERROR CHECK IS ', ALTGRTHRSH(ISAT) IF (HSALTCUT(ISAT) < 999999.) THEN - WRITE(IU06,*) ' THE INPUT MINIMUM WAVE HEIGHT IS ', & - & HSALTCUT(ISAT) + WRITE(IU06,*) ' THE INPUT MINIMUM WAVE HEIGHT IS ', HSALTCUT(ISAT) ELSE - WRITE(IU06,*) ' THE MINIMUM WAVE HEIGHT WILL BE', & - & ' THE OBSERVATION ERROR.' + WRITE(IU06,*) ' THE MINIMUM WAVE HEIGHT WILL BE THE OBSERVATION ERROR.' ENDIF IF (LALTGRDOUT(ISAT)) THEN WRITE(IU06,*) ' GRIDDED ALTIMETER FIELDS WILL BE PRODUCED FOR THIS ALTIMETER.' diff --git a/src/ecwam/yowaltas.F90 b/src/ecwam/yowaltas.F90 index 1d4263ee2..72c39b22c 100644 --- a/src/ecwam/yowaltas.F90 +++ b/src/ecwam/yowaltas.F90 @@ -43,6 +43,7 @@ MODULE YOWALTAS REAL(KIND=JWRB) :: HSCONSCOR(NUMALT) REAL(KIND=JWRB) :: ALTSDTHRSH(NUMALT) REAL(KIND=JWRB) :: ALTBGTHRSH(NUMALT) + REAL(KIND=JWRB) :: ALTGRTHRSH(NUMALT) REAL(KIND=JWRB) :: HSALTCUT(NUMALT) REAL(KIND=JWRB), ALLOCATABLE :: ALTDATA(:,:) @@ -141,6 +142,7 @@ MODULE YOWALTAS ! HEIGHTS. ! *ALTSDTHRSH* REAL THRESHOLD FOR SUSPICIOUS DATA (SEE GRFIELD). ! *ALTBGTHRSH* REAL THRESHOLD FOR BACKGROUND CHECK (SEE GRFIELD). +! *ALTGRTHRSH* REAL THRESHOLD FOR GROSS ERROR CHECK (SEE GRFIELD). ! *HSALTCUT* REAL USER INPUT OF THE MINIMUM WAVE HEIGHT ALLOWED ! FOR THE ALTIMETER WAVE HEIGHT. THE ACTUAL ! MINIMUM HSCUT=MIN(HSALTCUT,SIGMA_ALT) From 371bb7dbca0133d147c3c897f3d9781be10981f9 Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Fri, 5 Jul 2024 22:23:30 +0000 Subject: [PATCH 03/29] re merge with 49R1 --- src/ecwam/mpcrtbl.F90 | 2 +- src/ecwam/mpuserin.F90 | 1 + src/ecwam/preset_wgrib_template.F90 | 20 ++++++++++---------- 3 files changed, 12 insertions(+), 11 deletions(-) diff --git a/src/ecwam/mpcrtbl.F90 b/src/ecwam/mpcrtbl.F90 index 9ad62ddeb..b26081379 100644 --- a/src/ecwam/mpcrtbl.F90 +++ b/src/ecwam/mpcrtbl.F90 @@ -234,7 +234,7 @@ SUBROUTINE MPCRTBL ! PARAMETER 033 IR = DEFINE_PARAMETER( 33, 'hmax', 140218, 0, 0, 0, .True., .True., & - & 'MAXIMUM WAVE HEIGHT' ) + & 'ENVELOP MAXIMUM WAVE HEIGHT' ) ! PARAMETER 034 IR = DEFINE_PARAMETER( 34, 'tmax', 140217, 0, 0, 0, .True., .True., & diff --git a/src/ecwam/mpuserin.F90 b/src/ecwam/mpuserin.F90 index 9ac93c25b..ee1b2c85f 100644 --- a/src/ecwam/mpuserin.F90 +++ b/src/ecwam/mpuserin.F90 @@ -468,6 +468,7 @@ SUBROUTINE MPUSERIN ! DEFINITIONS ARE USED. ! LL_GRID_SIMPLE_MATRIX IF TRUE THEN THE 2D SPECTRA WILL USE THE LEGACY grid_simple_matrix ! TO ENCODE THE 2D SPECTRA in GRIB1. THIS SHOULD BE PHASED OUT as soon as feasible! +! LLRSTGRIBPARAM IF TRUE, UNKNOWN GRIB PARAMETER WILL BE RESET TO EXPERIMENTAL PARAMETER TABLE 212 ! LICERUN : FLAG CONTROLLING WHETHER OR NOT SEA ICE FRACTION (OR SST) ! FIEDS ARE PROVIDED WITH THE WIND FIELDS TO GENERATE THE ! SEA ICE MASK (TRUE BY DEFAULT). diff --git a/src/ecwam/preset_wgrib_template.F90 b/src/ecwam/preset_wgrib_template.F90 index 17f95167e..9a8906228 100644 --- a/src/ecwam/preset_wgrib_template.F90 +++ b/src/ecwam/preset_wgrib_template.F90 @@ -424,43 +424,43 @@ SUBROUTINE PRESET_WGRIB_TEMPLATE(CT, IGRIB_HANDLE, NGRIBV, LLCREATE, NBITSPERVAL ENDIF IF ( IGRIB_VERSION == 1 ) THEN - CALL IGRIB_GET_VALUE(NGRIB_HANDLE_IFS,'offsetToEndOf4DvarWindow',IDUM, KRET=IRET) + CALL IGRIB_GET_VALUE(IGRIB_HANDLE_IFS,'offsetToEndOf4DvarWindow',IDUM, KRET=IRET) ! set localFlag to 3 to prevent use of offsetToEndOf4DvarWindow ! if not used in the IFS template. IF (IRET /= 0) CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'localFlag',3) - CALL IGRIB_GET_VALUE(NGRIB_HANDLE_IFS,'systemNumber', IDUM, KRET=IRET) + CALL IGRIB_GET_VALUE(IGRIB_HANDLE_IFS,'systemNumber', IDUM, KRET=IRET) IF (IRET /= 0) THEN KSYSNB=65535 CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'systemNumber', KSYSNB) ENDIF - CALL IGRIB_GET_VALUE(NGRIB_HANDLE_IFS,'methodNumber', IDUM, KRET=IRET) + CALL IGRIB_GET_VALUE(IGRIB_HANDLE_IFS,'methodNumber', IDUM, KRET=IRET) IF (IRET /= 0) THEN KMETNB=65535 CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'methodNumber',KMETNB) ENDIF - CALL IGRIB_GET_VALUE(NGRIB_HANDLE_IFS,'referenceDate', IDUM, KRET=IRET) + CALL IGRIB_GET_VALUE(IGRIB_HANDLE_IFS,'referenceDate', IDUM, KRET=IRET) IF (IRET /= 0) THEN KREFDATE=0 CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'referenceDate',KREFDATE) ENDIF - CALL IGRIB_GET_VALUE(NGRIB_HANDLE_IFS,'climateDateFrom', IDUM, KRET=IRET) + CALL IGRIB_GET_VALUE(IGRIB_HANDLE_IFS,'climateDateFrom', IDUM, KRET=IRET) IF (IRET /= 0) CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'climateDateFrom',0) - CALL IGRIB_GET_VALUE(NGRIB_HANDLE_IFS,'climateDateTo', IDUM, KRET=IRET) + CALL IGRIB_GET_VALUE(IGRIB_HANDLE_IFS,'climateDateTo', IDUM, KRET=IRET) IF (IRET /= 0) CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'climateDateTo',0) - CALL IGRIB_GET_VALUE(NGRIB_HANDLE_IFS,'legBaseDate', IDUM, KRET=IRET) + CALL IGRIB_GET_VALUE(IGRIB_HANDLE_IFS,'legBaseDate', IDUM, KRET=IRET) IF (IRET /= 0) CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'legBaseDate',0) - CALL IGRIB_GET_VALUE(NGRIB_HANDLE_IFS,'legBaseTime', IDUM, KRET=IRET) + CALL IGRIB_GET_VALUE(IGRIB_HANDLE_IFS,'legBaseTime', IDUM, KRET=IRET) IF (IRET /= 0) CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'legBaseTime',0) - CALL IGRIB_GET_VALUE(NGRIB_HANDLE_IFS,'legNumber', IDUM, KRET=IRET) + CALL IGRIB_GET_VALUE(IGRIB_HANDLE_IFS,'legNumber', IDUM, KRET=IRET) IF (IRET /= 0) CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'legNumber',0) - CALL IGRIB_GET_VALUE(NGRIB_HANDLE_IFS,'oceanAtmosphereCoupling', IDUM, KRET=IRET) + CALL IGRIB_GET_VALUE(IGRIB_HANDLE_IFS,'oceanAtmosphereCoupling', IDUM, KRET=IRET) IF (IRET /= 0) CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'oceanAtmosphereCoupling',0) ENDIF From 341e88587ea4d7d02b2c198242648cbbc00445dd Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Sat, 6 Jul 2024 23:29:47 +0000 Subject: [PATCH 04/29] add outch.F90 --- src/ecwam/CMakeLists.txt | 1 + src/ecwam/outch.F90 | 111 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 112 insertions(+) create mode 100644 src/ecwam/outch.F90 diff --git a/src/ecwam/CMakeLists.txt b/src/ecwam/CMakeLists.txt index 9c67734ed..3d8d00017 100644 --- a/src/ecwam/CMakeLists.txt +++ b/src/ecwam/CMakeLists.txt @@ -167,6 +167,7 @@ list( APPEND ecwam_srcs out_onegrdpt_sp.F90 outbc.F90 outbeta.F90 + outch.F90 outblock.F90 outbs.F90 outcom.F90 diff --git a/src/ecwam/outch.F90 b/src/ecwam/outch.F90 new file mode 100644 index 000000000..dcf8c18b8 --- /dev/null +++ b/src/ecwam/outch.F90 @@ -0,0 +1,111 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + +SUBROUTINE OUTCH (KIJS, KIJL, & + & ZUST, PCHAR , PCHARHQ, CD, & + & CH, CHS) + +! ---------------------------------------------------------------------- + +!**** *OUTCH* - DETERMINES THE HEAT EXCHANGE COEFFICIENT BASED ON Janssen( Tech memo 239, 1997) +! and Peter A.E.M.Janssen and Jean-Raymond Bidlot, 2018: Progress in Operational Wave Forecasting, Procedia IUTAM +! Volume 26, 2018, Pages 14-29. + +! ---------------------------------------------------------------------- + +USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU + +USE YOWPCONS , ONLY : G , EPSUS +USE YOWPHYS , ONLY : XKAPPA, XNLEV, RNU, RNUM + +USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK + +! ---------------------------------------------------------------------- + +IMPLICIT NONE + +INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL +REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: ZUST ! FRICTION VELOCITY +REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: PCHAR ! CHARNOCK +REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: PCHARHQ ! EQUIVALENT CHARNOCK FIELD FOR HEAT AND MOISTURE +REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: CD ! NEUTRAL DRAG COEFFICIENT AT HEIGHT XNLEV +REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT):: CH ! HEAT EXCHANGE COEFFICIENT AT HEIGHT XNLEV (TM 239) +REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT):: CHS ! HEAT EXCHANGE COEFFICIENT AT HEIGHT XNLEV (Janssen and Bidlot 2018) + + +INTEGER(KIND=JWIM) :: IJ + +REAL(KIND=JWRB), PARAMETER :: RNUH = 0.40_JWRB * RNU ! REDUCED KINEMATIC AIR VISCOSITY FOR HEAT (see IFS documentation 3.2.4) + +REAL(KIND=JWRB) :: ZUST2, ZUSTM1, Z0M, Z0W, Z0H, Z0WHQ, Z0T, Z0TS +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ROUGNESS LENGTH FUNCTIONS +! -------- ------ --------- + + +! JEAN BIDLOT E.C.M.W.F. sea-state dependent latent and sensible transfer coefficients +! after Janssen( Tech memo 239, 1997) +! ------------------------------------------------------------------ + +! AERODYNAMIC ROUGHNESS LENGTH OVER SEAS AND OCEANS: +! -------------------------------------------------- +REAL(KIND=JWRB) :: PCHARNOCK ! CHARNOCK PARAMETER +REAL(KIND=JWRB) :: PUST2 ! FRICTION VELOCITY SQUARED + +REAL(KIND=JWRB) :: PZ0SEA ! ROUGHNESS LENGTH FOR MOMEMTUM OVER SEA DUE TO WAVES +PZ0SEA(G, PCHARNOCK, PUST2) = (PCHARNOCK/G)*PUST2 + + +! ROUGHNESS LENGTH FOR HEAT AND HUMIDITY OVER SEAS AND OCEANS: +! ------------------------------------------------------------ +REAL(KIND=JWRB), PARAMETER :: Z0HQMIN=0.0000001_JWRB +REAL(KIND=JWRB) :: PZ0 ! ROUGHNESS LENGTH FOR MOMEMTUM OVER SEA +REAL(KIND=JWRB) :: PZ0HQ ! ROUGHNESS LENGTH FOR MOMEMTUM OVER SEA WITHOUT THE OCEAN WAVES CONTRIBUTION +REAL(KIND=JWRB) :: PZN ! ROUGHNESS LENGTH FOR HEAT OR HUMIDITY OVER SEA +REAL(KIND=JWRB) :: PZP +REAL(KIND=JWRB) :: PZM + +REAL(KIND=JWRB) :: PZPLUS ! LARGEST ROOT OF Z**2 + (PZN+2*PZ0HQ)*Z + PZN*PZ0HQ = 0 +PZPLUS(PZ0HQ, PZN) = -(PZ0HQ+0.5_JWRB*PZN)+SQRT(PZ0HQ**2+0.25_JWRB*PZN**2) + +REAL(KIND=JWRB) :: PZMINS ! SMALLEST ROOT OF Z**2 + (PZN+2*PZ0HQ)*Z + PZN*PZ0HQ = 0 +PZMINS(PZ0HQ, PZN) = -(PZ0HQ+0.5_JWRB*PZN)-SQRT(PZ0HQ**2+0.25_JWRB*PZN**2) + +REAL(KIND=JWRB) :: PZZ ! USEFUL FUNCTION +PZZ(PZ0HQ, PZP, PZM) = ABS(PZP)**((PZ0HQ+PZP)/(PZP-PZM)) + +REAL(KIND=JWRB) :: PZNSEA ! ROUGHNESS LENGTH FOR HEAT OR HUMIDITY OVER SEA AND OCEANS +PZNSEA(PZ0HQ, PZN, PZ0, PUST2) = MAX( PZZ(PZ0HQ, PZPLUS(PZ0HQ,PZN), PZMINS(PZ0HQ,PZN)) * & + & PZZ(PZ0HQ, PZMINS(PZ0HQ,PZN), PZPLUS(PZ0HQ,PZN)), & + & Z0HQMIN) + +! ---------------------------------------------------------------------- + +IF (LHOOK) CALL DR_HOOK('OUTCH',0,ZHOOK_HANDLE) + +DO IJ = KIJS,KIJL + ZUSTM1=1.0_JPRB/MAX(ZUST(IJ),EPSUS) + Z0M=RNUM*ZUSTM1 + ZUST2=ZUST(IJ)**2 + Z0W=PZ0SEA(G,PCHAR,ZUST2) + + Z0H=RNUH*ZUSTM1 + Z0WHQ=PZ0SEA(G,PCHARHQ(IJ),ZUST2) + + Z0T=PZNSEA(Z0WHQ,Z0H,Z0W,ZUST2) + CH(IJ)=SQRT(CD(IJ)) * XKAPPA / LOG(1.0_JWRB + XNLEV/Z0T) + + Z0TS=SQRT(Z0H*(Z0M+Z0W)) + CHS(IJ)=SQRT(CD(IJ)) * XKAPPA / LOG(1.0_JWRB + XNLEV/Z0TS) +ENDDO + +IF (LHOOK) CALL DR_HOOK('OUTCH',1,ZHOOK_HANDLE) +! ---------------------------------------------------------------------- +END SUBROUTINE OUTCH From e16fa1f09065fcc373f665f89b84ca413f1e2356 Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Sun, 7 Jul 2024 10:01:46 +0000 Subject: [PATCH 05/29] generalise outch --- src/ecwam/outch.F90 | 70 ++++++++++++++++++++++++++++++++------------- 1 file changed, 50 insertions(+), 20 deletions(-) diff --git a/src/ecwam/outch.F90 b/src/ecwam/outch.F90 index dcf8c18b8..4f15723c9 100644 --- a/src/ecwam/outch.F90 +++ b/src/ecwam/outch.F90 @@ -7,20 +7,19 @@ ! nor does it submit to any jurisdiction. ! -SUBROUTINE OUTCH (KIJS, KIJL, & +SUBROUTINE OUTCH (KIJS, KIJL, IMETHOD, & & ZUST, PCHAR , PCHARHQ, CD, & - & CH, CHS) + & CH) ! ---------------------------------------------------------------------- -!**** *OUTCH* - DETERMINES THE HEAT EXCHANGE COEFFICIENT BASED ON Janssen( Tech memo 239, 1997) -! and Peter A.E.M.Janssen and Jean-Raymond Bidlot, 2018: Progress in Operational Wave Forecasting, Procedia IUTAM -! Volume 26, 2018, Pages 14-29. +!**** *OUTCH* - DETERMINES THE NEUTRAL HEAT EXCHANGE COEFFICIENT. ! ---------------------------------------------------------------------- USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU +USE YOWABORT , ONLY : WAM_ABORT USE YOWPCONS , ONLY : G , EPSUS USE YOWPHYS , ONLY : XKAPPA, XNLEV, RNU, RNUM @@ -31,19 +30,25 @@ SUBROUTINE OUTCH (KIJS, KIJL, & IMPLICIT NONE INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL +INTEGER(KIND=JWIM), INTENT(IN) :: IMETHOD ! = 0 no sea state effect + ! = 1 based on Janssen( Tech memo 239, 1997) + ! = 2 based on Janssen and Bidlot, 2018 + ! Progress in Operational Wave Forecasting, Procedia IUTAM + ! Volume 26, 2018, Pages 14-29. + REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: ZUST ! FRICTION VELOCITY REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: PCHAR ! CHARNOCK REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: PCHARHQ ! EQUIVALENT CHARNOCK FIELD FOR HEAT AND MOISTURE REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: CD ! NEUTRAL DRAG COEFFICIENT AT HEIGHT XNLEV -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT):: CH ! HEAT EXCHANGE COEFFICIENT AT HEIGHT XNLEV (TM 239) -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT):: CHS ! HEAT EXCHANGE COEFFICIENT AT HEIGHT XNLEV (Janssen and Bidlot 2018) +REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT):: CH ! NEUTRAL HEAT EXCHANGE COEFFICIENT AT HEIGHT XNLEV INTEGER(KIND=JWIM) :: IJ -REAL(KIND=JWRB), PARAMETER :: RNUH = 0.40_JWRB * RNU ! REDUCED KINEMATIC AIR VISCOSITY FOR HEAT (see IFS documentation 3.2.4) +REAL(KIND=JWRB) :: RNUH +REAL(KIND=JWRB) :: Z0M, Z0W, Z0H, Z0WHQ +REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: ZUST2, ZUSTM1, Z0T, SQRTCDKAPPA -REAL(KIND=JWRB) :: ZUST2, ZUSTM1, Z0M, Z0W, Z0H, Z0WHQ, Z0T, Z0TS REAL(KIND=JPHOOK) :: ZHOOK_HANDLE ! ROUGNESS LENGTH FUNCTIONS @@ -90,20 +95,45 @@ SUBROUTINE OUTCH (KIJS, KIJL, & IF (LHOOK) CALL DR_HOOK('OUTCH',0,ZHOOK_HANDLE) -DO IJ = KIJS,KIJL - ZUSTM1=1.0_JPRB/MAX(ZUST(IJ),EPSUS) - Z0M=RNUM*ZUSTM1 - ZUST2=ZUST(IJ)**2 - Z0W=PZ0SEA(G,PCHAR,ZUST2) +RNUH = 0.40_JWRB * RNU ! REDUCED KINEMATIC AIR VISCOSITY FOR HEAT (see IFS documentation 3.2.4) - Z0H=RNUH*ZUSTM1 - Z0WHQ=PZ0SEA(G,PCHARHQ(IJ),ZUST2) +DO IJ = KIJS,KIJL + ZUSTM1(IJ)=1.0_JWRB/MAX(ZUST(IJ),EPSUS) + ZUST2(IJ)=ZUST(IJ)**2 + SQRTCDKAPPA(IJ)=SQRT(CD(IJ))*XKAPPA +ENDDO - Z0T=PZNSEA(Z0WHQ,Z0H,Z0W,ZUST2) - CH(IJ)=SQRT(CD(IJ)) * XKAPPA / LOG(1.0_JWRB + XNLEV/Z0T) +SELECT CASE (IMETHOD) +CASE(0) + DO IJ = KIJS,KIJL + Z0T(IJ) = RNUH*ZUSTM1(IJ) + ENDDO + +CASE(1) + DO IJ = KIJS,KIJL + Z0M=RNUM*ZUSTM1(IJ) + Z0W=PZ0SEA(G,PCHAR(IJ),ZUST2(IJ)) + Z0H=RNUH*ZUSTM1(IJ) + Z0WHQ=PZ0SEA(G,PCHARHQ(IJ),ZUST2(IJ)) + Z0T(IJ)=PZNSEA(Z0WHQ,Z0H,Z0W,ZUST2(IJ)) + ENDDO + +CASE(2) + DO IJ = KIJS,KIJL + Z0M=RNUM*ZUSTM1(IJ) + Z0W=PZ0SEA(G,PCHAR(IJ),ZUST2(IJ)) + Z0H=RNUH*ZUSTM1(IJ) + Z0T(IJ)=SQRT(Z0H*(Z0M+Z0W)) + ENDDO + +CASE DEFAULT + CALL WAM_ABORT('Invalid value of IMETHOD variable.', & + & __FILENAME__, __LINE__) + +END SELECT - Z0TS=SQRT(Z0H*(Z0M+Z0W)) - CHS(IJ)=SQRT(CD(IJ)) * XKAPPA / LOG(1.0_JWRB + XNLEV/Z0TS) +DO IJ = KIJS,KIJL + CH(IJ)= SQRTCDKAPPA(IJ) / LOG(1.0_JWRB + XNLEV/Z0T(IJ)) ENDDO IF (LHOOK) CALL DR_HOOK('OUTCH',1,ZHOOK_HANDLE) From 7c7b96bd3b38d896ba1574de3a3109cf6867d2a7 Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Wed, 24 Jul 2024 16:35:33 +0000 Subject: [PATCH 06/29] LL_GRID_SIMPLE_MATRIX false --- src/ecwam/mpuserin.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ecwam/mpuserin.F90 b/src/ecwam/mpuserin.F90 index ee1b2c85f..3e3ab5369 100644 --- a/src/ecwam/mpuserin.F90 +++ b/src/ecwam/mpuserin.F90 @@ -726,7 +726,7 @@ SUBROUTINE MPUSERIN LNEWLVTP = .FALSE. - LL_GRID_SIMPLE_MATRIX = .TRUE. + LL_GRID_SIMPLE_MATRIX = .FALSE. LLRSTGRIBPARAM = .FALSE. From 2f4185dbbf101ebb6d7aa30c3ad9fd30d11612d1 Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Mon, 29 Jul 2024 12:14:41 +0000 Subject: [PATCH 07/29] fix out_onegrdpt.F90 when mss is not output --- src/ecwam/out_onegrdpt.F90 | 76 ++++++++++++++------------------------ 1 file changed, 27 insertions(+), 49 deletions(-) diff --git a/src/ecwam/out_onegrdpt.F90 b/src/ecwam/out_onegrdpt.F90 index de7e7fcb1..2967578ff 100644 --- a/src/ecwam/out_onegrdpt.F90 +++ b/src/ecwam/out_onegrdpt.F90 @@ -81,7 +81,7 @@ SUBROUTINE OUT_ONEGRDPT(IU06) LOGICAL, SAVE :: FRSTIME LOGICAL :: LPARAM - LOGICAL :: LDEPTH, LPHIAW, LPHIOC, LTAUOC + LOGICAL :: LMSS, LDEPTH, LPHIAW, LPHIOC, LTAUOC DATA FRSTIME/.TRUE./ ! @@ -102,85 +102,59 @@ SUBROUTINE OUT_ONEGRDPT(IU06) CALL DIFDATE(CDATEA,CDTPRO,ITIME) + LPARAM=.TRUE. + IPHS=ITOBOUT(IRHS) - IF(IPHS.GT.0) THEN - LPARAM = .TRUE. - ELSE - LPARAM = .FALSE. - ENDIF + IF (IPHS <= 0) LPARAM = .FALSE. IPCD=ITOBOUT(IRCD) - IF(IPCD.GT.0) THEN - LPARAM = .TRUE. - ELSE - LPARAM = .FALSE. - ENDIF + IF (IPCD <= 0) LPARAM = .FALSE. IPU10=ITOBOUT(IRU10) - IF(IPU10.GT.0) THEN - LPARAM = .TRUE. - ELSE - LPARAM = .FALSE. - ENDIF + IF (IPU10 <= 0) LPARAM = .FALSE. IPTP=ITOBOUT(IRTP) - IF(IPTP.GT.0) THEN - LPARAM = .TRUE. - ELSE - LPARAM = .FALSE. - ENDIF + IF (IPTP <= 0) LPARAM = .FALSE. IPT1=ITOBOUT(IRT1) - IF(IPT1.GT.0) THEN - LPARAM = .TRUE. - ELSE - LPARAM = .FALSE. - ENDIF + IF (IPT1 <= 0) LPARAM = .FALSE. IPHSWS=ITOBOUT(IRHSWS) - IF(IPHSWS.GT.0) THEN - LPARAM = .TRUE. - ELSE - LPARAM = .FALSE. - ENDIF + IF (IPHSWS <= 0) LPARAM = .FALSE. IPT1WS=ITOBOUT(IRT1WS) - IF(IPT1WS.GT.0) THEN - LPARAM = .TRUE. - ELSE - LPARAM = .FALSE. - ENDIF + IF (IPT1WS <= 0) LPARAM = .FALSE. IPMSS=ITOBOUT(IRMSS) - IF(IPMSS.GT.0) THEN - LPARAM = .TRUE. + IF (IPMSS > 0) THEN + LMSS = .TRUE. ELSE - LPARAM = .FALSE. + LMSS = .FALSE. ENDIF IPBATHY=ITOBOUT(IRBATHY) - IF(IPBATHY.GT.0) THEN + IF (IPBATHY > 0) THEN LDEPTH = .TRUE. ELSE LDEPTH = .FALSE. ENDIF IPPHIAW=ITOBOUT(IRPHIAW) - IF(IPPHIAW.GT.0) THEN + IF ( IPPHIAW > 0) THEN LPHIAW = .TRUE. ELSE LPHIAW = .FALSE. ENDIF IPPHIOC=ITOBOUT(IRPHIOC) - IF(IPPHIOC.GT.0) THEN + IF (IPPHIOC > 0) THEN LPHIOC = .TRUE. ELSE LPHIOC = .FALSE. ENDIF IPTAUOC=ITOBOUT(IRTAUOC) - IF(IPTAUOC.GT.0) THEN + IF (IPTAUOC > 0) THEN LTAUOC = .TRUE. ELSE LTAUOC = .FALSE. @@ -189,8 +163,8 @@ SUBROUTINE OUT_ONEGRDPT(IU06) IF (LPARAM .AND. (.NOT. LLUNSTR)) THEN I = MAX(1,NGX/2) DO J = 1,NGY - IF (GOUT(IPHS,I,J).NE.ZMISS) THEN - IF(LDEPTH) THEN + IF (GOUT(IPHS,I,J) /= ZMISS) THEN + IF (LDEPTH) THEN DEPTH=GOUT(IPBATHY,I,J) ELSE DEPTH=999.0_JWRB @@ -201,7 +175,11 @@ SUBROUTINE OUT_ONEGRDPT(IU06) CD = GOUT(IPCD,I,J) U10 = GOUT(IPU10,I,J) HS = GOUT(IPHS,I,J) - ZMSS = GOUT(IPMSS,I,J) + IF (LMSS) THEN + ZMSS = GOUT(IPMSS,I,J) + ELSE + ZMSS = 0.0_JWRB + ENDIF USTAR2 = MAX(CD*MAX(U10**2,EPSU10**2),EPSUS) USTAR = SQRT(USTAR2) @@ -250,20 +228,20 @@ SUBROUTINE OUT_ONEGRDPT(IU06) E_LIM = BETA_K**2/16.0_JWRB E_OBS = E_LIM/(1.+T_0/T10)**XP - IF(LPHIAW) THEN + IF (LPHIAW) THEN PHIAW=GOUT(IPPHIAW,I,J) ELSE PHIAW=3.5_JWRB ENDIF - IF(LPHIOC) THEN + IF (LPHIOC) THEN ! make it positive for comparison with PHIAW PHIOC=-GOUT(IPPHIOC,I,J) ELSE PHIOC=3.5_JWRB ENDIF - IF(LTAUOC) THEN + IF (LTAUOC) THEN TAUOC=GOUT(IPTAUOC,I,J) ELSE TAUOC=1.0_JWRB From 6364ef3adf3857ea295f7c51134b7c9d2f17e02a Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Mon, 12 Aug 2024 10:19:22 +0000 Subject: [PATCH 08/29] remove contributions that are not altimeter related --- src/ecwam/CMakeLists.txt | 1 - src/ecwam/out_onegrdpt.F90 | 76 ++++++---- src/ecwam/outch.F90 | 141 ------------------ src/programs/create_wam_bathymetry_ETOPO1.F90 | 3 +- 4 files changed, 51 insertions(+), 170 deletions(-) delete mode 100644 src/ecwam/outch.F90 diff --git a/src/ecwam/CMakeLists.txt b/src/ecwam/CMakeLists.txt index 3d8d00017..9c67734ed 100644 --- a/src/ecwam/CMakeLists.txt +++ b/src/ecwam/CMakeLists.txt @@ -167,7 +167,6 @@ list( APPEND ecwam_srcs out_onegrdpt_sp.F90 outbc.F90 outbeta.F90 - outch.F90 outblock.F90 outbs.F90 outcom.F90 diff --git a/src/ecwam/out_onegrdpt.F90 b/src/ecwam/out_onegrdpt.F90 index 2967578ff..de7e7fcb1 100644 --- a/src/ecwam/out_onegrdpt.F90 +++ b/src/ecwam/out_onegrdpt.F90 @@ -81,7 +81,7 @@ SUBROUTINE OUT_ONEGRDPT(IU06) LOGICAL, SAVE :: FRSTIME LOGICAL :: LPARAM - LOGICAL :: LMSS, LDEPTH, LPHIAW, LPHIOC, LTAUOC + LOGICAL :: LDEPTH, LPHIAW, LPHIOC, LTAUOC DATA FRSTIME/.TRUE./ ! @@ -102,59 +102,85 @@ SUBROUTINE OUT_ONEGRDPT(IU06) CALL DIFDATE(CDATEA,CDTPRO,ITIME) - LPARAM=.TRUE. - IPHS=ITOBOUT(IRHS) - IF (IPHS <= 0) LPARAM = .FALSE. + IF(IPHS.GT.0) THEN + LPARAM = .TRUE. + ELSE + LPARAM = .FALSE. + ENDIF IPCD=ITOBOUT(IRCD) - IF (IPCD <= 0) LPARAM = .FALSE. + IF(IPCD.GT.0) THEN + LPARAM = .TRUE. + ELSE + LPARAM = .FALSE. + ENDIF IPU10=ITOBOUT(IRU10) - IF (IPU10 <= 0) LPARAM = .FALSE. + IF(IPU10.GT.0) THEN + LPARAM = .TRUE. + ELSE + LPARAM = .FALSE. + ENDIF IPTP=ITOBOUT(IRTP) - IF (IPTP <= 0) LPARAM = .FALSE. + IF(IPTP.GT.0) THEN + LPARAM = .TRUE. + ELSE + LPARAM = .FALSE. + ENDIF IPT1=ITOBOUT(IRT1) - IF (IPT1 <= 0) LPARAM = .FALSE. + IF(IPT1.GT.0) THEN + LPARAM = .TRUE. + ELSE + LPARAM = .FALSE. + ENDIF IPHSWS=ITOBOUT(IRHSWS) - IF (IPHSWS <= 0) LPARAM = .FALSE. + IF(IPHSWS.GT.0) THEN + LPARAM = .TRUE. + ELSE + LPARAM = .FALSE. + ENDIF IPT1WS=ITOBOUT(IRT1WS) - IF (IPT1WS <= 0) LPARAM = .FALSE. + IF(IPT1WS.GT.0) THEN + LPARAM = .TRUE. + ELSE + LPARAM = .FALSE. + ENDIF IPMSS=ITOBOUT(IRMSS) - IF (IPMSS > 0) THEN - LMSS = .TRUE. + IF(IPMSS.GT.0) THEN + LPARAM = .TRUE. ELSE - LMSS = .FALSE. + LPARAM = .FALSE. ENDIF IPBATHY=ITOBOUT(IRBATHY) - IF (IPBATHY > 0) THEN + IF(IPBATHY.GT.0) THEN LDEPTH = .TRUE. ELSE LDEPTH = .FALSE. ENDIF IPPHIAW=ITOBOUT(IRPHIAW) - IF ( IPPHIAW > 0) THEN + IF(IPPHIAW.GT.0) THEN LPHIAW = .TRUE. ELSE LPHIAW = .FALSE. ENDIF IPPHIOC=ITOBOUT(IRPHIOC) - IF (IPPHIOC > 0) THEN + IF(IPPHIOC.GT.0) THEN LPHIOC = .TRUE. ELSE LPHIOC = .FALSE. ENDIF IPTAUOC=ITOBOUT(IRTAUOC) - IF (IPTAUOC > 0) THEN + IF(IPTAUOC.GT.0) THEN LTAUOC = .TRUE. ELSE LTAUOC = .FALSE. @@ -163,8 +189,8 @@ SUBROUTINE OUT_ONEGRDPT(IU06) IF (LPARAM .AND. (.NOT. LLUNSTR)) THEN I = MAX(1,NGX/2) DO J = 1,NGY - IF (GOUT(IPHS,I,J) /= ZMISS) THEN - IF (LDEPTH) THEN + IF (GOUT(IPHS,I,J).NE.ZMISS) THEN + IF(LDEPTH) THEN DEPTH=GOUT(IPBATHY,I,J) ELSE DEPTH=999.0_JWRB @@ -175,11 +201,7 @@ SUBROUTINE OUT_ONEGRDPT(IU06) CD = GOUT(IPCD,I,J) U10 = GOUT(IPU10,I,J) HS = GOUT(IPHS,I,J) - IF (LMSS) THEN - ZMSS = GOUT(IPMSS,I,J) - ELSE - ZMSS = 0.0_JWRB - ENDIF + ZMSS = GOUT(IPMSS,I,J) USTAR2 = MAX(CD*MAX(U10**2,EPSU10**2),EPSUS) USTAR = SQRT(USTAR2) @@ -228,20 +250,20 @@ SUBROUTINE OUT_ONEGRDPT(IU06) E_LIM = BETA_K**2/16.0_JWRB E_OBS = E_LIM/(1.+T_0/T10)**XP - IF (LPHIAW) THEN + IF(LPHIAW) THEN PHIAW=GOUT(IPPHIAW,I,J) ELSE PHIAW=3.5_JWRB ENDIF - IF (LPHIOC) THEN + IF(LPHIOC) THEN ! make it positive for comparison with PHIAW PHIOC=-GOUT(IPPHIOC,I,J) ELSE PHIOC=3.5_JWRB ENDIF - IF (LTAUOC) THEN + IF(LTAUOC) THEN TAUOC=GOUT(IPTAUOC,I,J) ELSE TAUOC=1.0_JWRB diff --git a/src/ecwam/outch.F90 b/src/ecwam/outch.F90 deleted file mode 100644 index 4f15723c9..000000000 --- a/src/ecwam/outch.F90 +++ /dev/null @@ -1,141 +0,0 @@ -! (C) Copyright 1989- ECMWF. -! -! This software is licensed under the terms of the Apache Licence Version 2.0 -! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! In applying this licence, ECMWF does not waive the privileges and immunities -! granted to it by virtue of its status as an intergovernmental organisation -! nor does it submit to any jurisdiction. -! - -SUBROUTINE OUTCH (KIJS, KIJL, IMETHOD, & - & ZUST, PCHAR , PCHARHQ, CD, & - & CH) - -! ---------------------------------------------------------------------- - -!**** *OUTCH* - DETERMINES THE NEUTRAL HEAT EXCHANGE COEFFICIENT. - -! ---------------------------------------------------------------------- - -USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU - -USE YOWABORT , ONLY : WAM_ABORT -USE YOWPCONS , ONLY : G , EPSUS -USE YOWPHYS , ONLY : XKAPPA, XNLEV, RNU, RNUM - -USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK - -! ---------------------------------------------------------------------- - -IMPLICIT NONE - -INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL -INTEGER(KIND=JWIM), INTENT(IN) :: IMETHOD ! = 0 no sea state effect - ! = 1 based on Janssen( Tech memo 239, 1997) - ! = 2 based on Janssen and Bidlot, 2018 - ! Progress in Operational Wave Forecasting, Procedia IUTAM - ! Volume 26, 2018, Pages 14-29. - -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: ZUST ! FRICTION VELOCITY -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: PCHAR ! CHARNOCK -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: PCHARHQ ! EQUIVALENT CHARNOCK FIELD FOR HEAT AND MOISTURE -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: CD ! NEUTRAL DRAG COEFFICIENT AT HEIGHT XNLEV -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT):: CH ! NEUTRAL HEAT EXCHANGE COEFFICIENT AT HEIGHT XNLEV - - -INTEGER(KIND=JWIM) :: IJ - -REAL(KIND=JWRB) :: RNUH -REAL(KIND=JWRB) :: Z0M, Z0W, Z0H, Z0WHQ -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: ZUST2, ZUSTM1, Z0T, SQRTCDKAPPA - -REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - -! ROUGNESS LENGTH FUNCTIONS -! -------- ------ --------- - - -! JEAN BIDLOT E.C.M.W.F. sea-state dependent latent and sensible transfer coefficients -! after Janssen( Tech memo 239, 1997) -! ------------------------------------------------------------------ - -! AERODYNAMIC ROUGHNESS LENGTH OVER SEAS AND OCEANS: -! -------------------------------------------------- -REAL(KIND=JWRB) :: PCHARNOCK ! CHARNOCK PARAMETER -REAL(KIND=JWRB) :: PUST2 ! FRICTION VELOCITY SQUARED - -REAL(KIND=JWRB) :: PZ0SEA ! ROUGHNESS LENGTH FOR MOMEMTUM OVER SEA DUE TO WAVES -PZ0SEA(G, PCHARNOCK, PUST2) = (PCHARNOCK/G)*PUST2 - - -! ROUGHNESS LENGTH FOR HEAT AND HUMIDITY OVER SEAS AND OCEANS: -! ------------------------------------------------------------ -REAL(KIND=JWRB), PARAMETER :: Z0HQMIN=0.0000001_JWRB -REAL(KIND=JWRB) :: PZ0 ! ROUGHNESS LENGTH FOR MOMEMTUM OVER SEA -REAL(KIND=JWRB) :: PZ0HQ ! ROUGHNESS LENGTH FOR MOMEMTUM OVER SEA WITHOUT THE OCEAN WAVES CONTRIBUTION -REAL(KIND=JWRB) :: PZN ! ROUGHNESS LENGTH FOR HEAT OR HUMIDITY OVER SEA -REAL(KIND=JWRB) :: PZP -REAL(KIND=JWRB) :: PZM - -REAL(KIND=JWRB) :: PZPLUS ! LARGEST ROOT OF Z**2 + (PZN+2*PZ0HQ)*Z + PZN*PZ0HQ = 0 -PZPLUS(PZ0HQ, PZN) = -(PZ0HQ+0.5_JWRB*PZN)+SQRT(PZ0HQ**2+0.25_JWRB*PZN**2) - -REAL(KIND=JWRB) :: PZMINS ! SMALLEST ROOT OF Z**2 + (PZN+2*PZ0HQ)*Z + PZN*PZ0HQ = 0 -PZMINS(PZ0HQ, PZN) = -(PZ0HQ+0.5_JWRB*PZN)-SQRT(PZ0HQ**2+0.25_JWRB*PZN**2) - -REAL(KIND=JWRB) :: PZZ ! USEFUL FUNCTION -PZZ(PZ0HQ, PZP, PZM) = ABS(PZP)**((PZ0HQ+PZP)/(PZP-PZM)) - -REAL(KIND=JWRB) :: PZNSEA ! ROUGHNESS LENGTH FOR HEAT OR HUMIDITY OVER SEA AND OCEANS -PZNSEA(PZ0HQ, PZN, PZ0, PUST2) = MAX( PZZ(PZ0HQ, PZPLUS(PZ0HQ,PZN), PZMINS(PZ0HQ,PZN)) * & - & PZZ(PZ0HQ, PZMINS(PZ0HQ,PZN), PZPLUS(PZ0HQ,PZN)), & - & Z0HQMIN) - -! ---------------------------------------------------------------------- - -IF (LHOOK) CALL DR_HOOK('OUTCH',0,ZHOOK_HANDLE) - -RNUH = 0.40_JWRB * RNU ! REDUCED KINEMATIC AIR VISCOSITY FOR HEAT (see IFS documentation 3.2.4) - -DO IJ = KIJS,KIJL - ZUSTM1(IJ)=1.0_JWRB/MAX(ZUST(IJ),EPSUS) - ZUST2(IJ)=ZUST(IJ)**2 - SQRTCDKAPPA(IJ)=SQRT(CD(IJ))*XKAPPA -ENDDO - -SELECT CASE (IMETHOD) -CASE(0) - DO IJ = KIJS,KIJL - Z0T(IJ) = RNUH*ZUSTM1(IJ) - ENDDO - -CASE(1) - DO IJ = KIJS,KIJL - Z0M=RNUM*ZUSTM1(IJ) - Z0W=PZ0SEA(G,PCHAR(IJ),ZUST2(IJ)) - Z0H=RNUH*ZUSTM1(IJ) - Z0WHQ=PZ0SEA(G,PCHARHQ(IJ),ZUST2(IJ)) - Z0T(IJ)=PZNSEA(Z0WHQ,Z0H,Z0W,ZUST2(IJ)) - ENDDO - -CASE(2) - DO IJ = KIJS,KIJL - Z0M=RNUM*ZUSTM1(IJ) - Z0W=PZ0SEA(G,PCHAR(IJ),ZUST2(IJ)) - Z0H=RNUH*ZUSTM1(IJ) - Z0T(IJ)=SQRT(Z0H*(Z0M+Z0W)) - ENDDO - -CASE DEFAULT - CALL WAM_ABORT('Invalid value of IMETHOD variable.', & - & __FILENAME__, __LINE__) - -END SELECT - -DO IJ = KIJS,KIJL - CH(IJ)= SQRTCDKAPPA(IJ) / LOG(1.0_JWRB + XNLEV/Z0T(IJ)) -ENDDO - -IF (LHOOK) CALL DR_HOOK('OUTCH',1,ZHOOK_HANDLE) -! ---------------------------------------------------------------------- -END SUBROUTINE OUTCH diff --git a/src/programs/create_wam_bathymetry_ETOPO1.F90 b/src/programs/create_wam_bathymetry_ETOPO1.F90 index c4303e358..3451ff106 100644 --- a/src/programs/create_wam_bathymetry_ETOPO1.F90 +++ b/src/programs/create_wam_bathymetry_ETOPO1.F90 @@ -422,7 +422,8 @@ PROGRAM CREATE_BATHY_ETOPO1 ! FOR INTEGRATED PARAMETERS CALL PRESET_WGRIB_TEMPLATE("I",NGRIB_HANDLE_WAM_I,NGRIBV=2,LLCREATE=.true.,NBITSPERVALUE=24) ! FOR SPECTRA - CALL PRESET_WGRIB_TEMPLATE("S",NGRIB_HANDLE_WAM_S,NGRIBV=2,LLCREATE=.true.,NBITSPERVALUE=12) +!!! grib 2 spectra not yet implemented !!!! + CALL PRESET_WGRIB_TEMPLATE("S",NGRIB_HANDLE_WAM_S,NGRIBV=1,LLCREATE=.true.,NBITSPERVALUE=12) DO IP = 0, NPROPAGS WRITE(C1,'(I1)') IP From ebf6af80beaa113fd6b4ca6aea2e36c2af14121d Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Wed, 21 Aug 2024 16:18:22 +0000 Subject: [PATCH 09/29] grib 2 unresolved bathymetry obstructions --- src/programs/create_wam_bathymetry_ETOPO1.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/programs/create_wam_bathymetry_ETOPO1.F90 b/src/programs/create_wam_bathymetry_ETOPO1.F90 index 3451ff106..c4303e358 100644 --- a/src/programs/create_wam_bathymetry_ETOPO1.F90 +++ b/src/programs/create_wam_bathymetry_ETOPO1.F90 @@ -422,8 +422,7 @@ PROGRAM CREATE_BATHY_ETOPO1 ! FOR INTEGRATED PARAMETERS CALL PRESET_WGRIB_TEMPLATE("I",NGRIB_HANDLE_WAM_I,NGRIBV=2,LLCREATE=.true.,NBITSPERVALUE=24) ! FOR SPECTRA -!!! grib 2 spectra not yet implemented !!!! - CALL PRESET_WGRIB_TEMPLATE("S",NGRIB_HANDLE_WAM_S,NGRIBV=1,LLCREATE=.true.,NBITSPERVALUE=12) + CALL PRESET_WGRIB_TEMPLATE("S",NGRIB_HANDLE_WAM_S,NGRIBV=2,LLCREATE=.true.,NBITSPERVALUE=12) DO IP = 0, NPROPAGS WRITE(C1,'(I1)') IP From 73f5ce7d51b4315bba630ea09e26c4357bc09b4a Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Thu, 22 Aug 2024 15:21:35 +0000 Subject: [PATCH 10/29] to read Ocean surface currents --- src/ecwam/current2wam.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ecwam/current2wam.F90 b/src/ecwam/current2wam.F90 index abbd56142..9160fa496 100644 --- a/src/ecwam/current2wam.F90 +++ b/src/ecwam/current2wam.F90 @@ -245,7 +245,7 @@ SUBROUTINE CURRENT2WAM (FILNM, IREAD, CDATEIN, & CDATEIN_OLD=CDATEIN - IF (IPARAM == 131) THEN + IF (IPARAM == 131 .OR. IPARAM == 140) THEN !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(ICHNK, IJ, IX, JY) DO ICHNK = 1, NCHNK DO IJ = 1, NPROMA_WAM @@ -262,7 +262,7 @@ SUBROUTINE CURRENT2WAM (FILNM, IREAD, CDATEIN, & ENDDO !$OMP END PARALLEL DO - ELSEIF (IPARAM == 132) THEN + ELSEIF (IPARAM == 132 .OR. IPARAM == 139) THEN !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(ICHNK, IJ, IX, JY) DO ICHNK = 1, NCHNK DO IJ = 1, NPROMA_WAM From 667dd39b2af5766bd45af46dd98df073b6be5cac Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Fri, 23 Aug 2024 11:19:32 +0000 Subject: [PATCH 11/29] add how to deal with stapType=avg --- src/ecwam/grib2wgrid.F90 | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/ecwam/grib2wgrid.F90 b/src/ecwam/grib2wgrid.F90 index 439429374..247cffaf6 100644 --- a/src/ecwam/grib2wgrid.F90 +++ b/src/ecwam/grib2wgrid.F90 @@ -448,6 +448,17 @@ SUBROUTINE GRIB2WGRID (IU06, KPROMA, & STEP=(END_STEP-START_STEP)/2 ENDIF IFORP=STEP + ELSEIF (CSTEPTYPE(1:3) == 'avg') THEN + CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'stepUnits','s') + CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'startStep',START_STEP) + CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'endStep',END_STEP) +! THE DATA ARE VALID BETWEEN TWO TIMES. TAKE THE MIDDLE POINT + IF (START_STEP /= END_STEP) THEN + STEP=(END_STEP-START_STEP)/2 + ELSE + STEP=START_STEP + ENDIF + IFORP=STEP ELSE WRITE(*,*) 'UNKNOWN DEFINITION OF FORECAST STEP TYPE !!!' WRITE(*,*) 'stepType = ',CSTEPTYPE From bd5573608f605cd2eeea6ce70c08fadbe7c53268 Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Fri, 23 Aug 2024 12:13:23 +0000 Subject: [PATCH 12/29] debug --- src/ecwam/current2wam.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/ecwam/current2wam.F90 b/src/ecwam/current2wam.F90 index 9160fa496..1fef1a765 100644 --- a/src/ecwam/current2wam.F90 +++ b/src/ecwam/current2wam.F90 @@ -94,7 +94,7 @@ SUBROUTINE CURRENT2WAM (FILNM, IREAD, CDATEIN, & TYPE(ENVIRONMENT), INTENT(INOUT) :: WVENVI - INTEGER(KIND=JWIM) :: NBIT = 1000000 + INTEGER(KIND=JWIM) :: NBIT = 1100000 INTEGER(KIND=JWIM) :: KFILE_HANDLE1 INTEGER(KIND=JWIM) :: LFILE, KGRIB_HANDLE @@ -244,6 +244,8 @@ SUBROUTINE CURRENT2WAM (FILNM, IREAD, CDATEIN, & CDATEIN_OLD=CDATEIN + write(*,*) 'debile current2wam iparam ', iparam + write(*,*) 'debile current2wam before ', NXS, NXE, NYS, NYE, NCHNK, NPROMA_WAM IF (IPARAM == 131 .OR. IPARAM == 140) THEN !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(ICHNK, IJ, IX, JY) @@ -251,6 +253,9 @@ SUBROUTINE CURRENT2WAM (FILNM, IREAD, CDATEIN, & DO IJ = 1, NPROMA_WAM IX = BLK2LOC%IFROMIJ(IJ, ICHNK) JY = BLK2LOC%JFROMIJ(IJ, ICHNK) + + write(*,*) 'debile current2wam ',IX,JY, ICHNK, IJ + WVENVI%UCUR(IJ,ICHNK) = FIELD(IX,JY) ! SOME WAM MODEL GRID POINTS MAY HAVE A MISSING DATA FROM ! OCEAN MODEL. THEY ARE SET TO 0. From 160312c5663186f57c65bb89fa6b25d298bf6128 Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Fri, 23 Aug 2024 17:28:54 +0000 Subject: [PATCH 13/29] cleanup --- src/ecwam/current2wam.F90 | 6 ------ src/ecwam/getcurr.F90 | 23 ++++++++++++----------- 2 files changed, 12 insertions(+), 17 deletions(-) diff --git a/src/ecwam/current2wam.F90 b/src/ecwam/current2wam.F90 index 1fef1a765..b99237c3a 100644 --- a/src/ecwam/current2wam.F90 +++ b/src/ecwam/current2wam.F90 @@ -244,18 +244,12 @@ SUBROUTINE CURRENT2WAM (FILNM, IREAD, CDATEIN, & CDATEIN_OLD=CDATEIN - write(*,*) 'debile current2wam iparam ', iparam - write(*,*) 'debile current2wam before ', NXS, NXE, NYS, NYE, NCHNK, NPROMA_WAM - IF (IPARAM == 131 .OR. IPARAM == 140) THEN !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(ICHNK, IJ, IX, JY) DO ICHNK = 1, NCHNK DO IJ = 1, NPROMA_WAM IX = BLK2LOC%IFROMIJ(IJ, ICHNK) JY = BLK2LOC%JFROMIJ(IJ, ICHNK) - - write(*,*) 'debile current2wam ',IX,JY, ICHNK, IJ - WVENVI%UCUR(IJ,ICHNK) = FIELD(IX,JY) ! SOME WAM MODEL GRID POINTS MAY HAVE A MISSING DATA FROM ! OCEAN MODEL. THEY ARE SET TO 0. diff --git a/src/ecwam/getcurr.F90 b/src/ecwam/getcurr.F90 index 2e1b5d38f..323247dbb 100644 --- a/src/ecwam/getcurr.F90 +++ b/src/ecwam/getcurr.F90 @@ -68,7 +68,8 @@ SUBROUTINE GETCURR(LWCUR, IREAD, BLK2LOC, & USE YOWUBUF , ONLY : LUPDTWGHT USE YOWWIND , ONLY : LLNEWCURR - USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK + USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK + USE EC_LUN , ONLY : NULERR USE MPL_MODULE, ONLY : MPL_ALLREDUCE ! -------------------------------------------------------------------- @@ -207,16 +208,16 @@ SUBROUTINE GETCURR(LWCUR, IREAD, BLK2LOC, & IF (CDATEIN /= CDTCUR) THEN - WRITE (IU06,*) ' **************************************' - WRITE (IU06,*) ' * *' - WRITE (IU06,*) ' * PROBLEM IN GETCURR : *' - WRITE (IU06,*) ' * THE REQUESTED DATE FOR THE CURRENTS*' - WRITE (IU06,*) ' * DOES NOT CORRESPOND TO THE DECODED *' - WRITE (IU06,*) ' * DATE !!!! *' - WRITE (IU06,*) ' * CDTCUR =',CDTCUR - WRITE (IU06,*) ' * CDATEIN=',CDATEIN - WRITE (IU06,*) ' * *' - WRITE (IU06,*) ' **************************************' + WRITE (NULERR,*) ' **************************************' + WRITE (NULERR,*) ' * *' + WRITE (NULERR,*) ' * PROBLEM IN GETCURR : *' + WRITE (NULERR,*) ' * THE REQUESTED DATE FOR THE CURRENTS*' + WRITE (NULERR,*) ' * DOES NOT CORRESPOND TO THE DECODED *' + WRITE (NULERR,*) ' * DATE !!!! *' + WRITE (NULERR,*) ' * CDTCUR =',CDTCUR + WRITE (NULERR,*) ' * CDATEIN=',CDATEIN + WRITE (NULERR,*) ' * *' + WRITE (NULERR,*) ' **************************************' CALL ABORT1 ENDIF ELSE From 7ca7e02294cbe3d8ff4db0e012a96e8bcf6f5b7e Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Fri, 23 Aug 2024 21:56:43 +0000 Subject: [PATCH 14/29] cleanup --- src/ecwam/current2wam.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/ecwam/current2wam.F90 b/src/ecwam/current2wam.F90 index b99237c3a..87789b58e 100644 --- a/src/ecwam/current2wam.F90 +++ b/src/ecwam/current2wam.F90 @@ -30,7 +30,7 @@ SUBROUTINE CURRENT2WAM (FILNM, IREAD, CDATEIN, & ! *CALL* *CURRENT2WAM(FILNM, IREAD, CDATEIN, ! IFROMIJ, JFROMIJ, ! NXS, NXE, NYS, NYE, FIELDG, -! UCUR, VCUR) +! WVENVI) ! *FILNM* DATA INPUT FILENAME. ! *IREAD* RANK OF THE PROCESS WHICH INPUTS THE DATA. @@ -40,8 +40,8 @@ SUBROUTINE CURRENT2WAM (FILNM, IREAD, CDATEIN, & ! *NXS:NXE* FIRST DIMENSION OF FIELDG ! *NYS:NYE* SECOND DIMENSION OF FIELDG ! *FIELDG* INPUT FORCING FIELDS ON THE WAVE MODEL GRID -! *UCUR* U-COMPONENT OF SURFACE CURRENT -! *VCUR* V-COMPONENT OF SURFACE CURRENT +! *WVENVI%UCUR* U-COMPONENT OF SURFACE CURRENT +! *WVENVI%VCUR* V-COMPONENT OF SURFACE CURRENT ! METHOD. From ef25f84fe50fdcbda02e04f690b386e93c7010ee Mon Sep 17 00:00:00 2001 From: Ahmad Nawab Date: Mon, 2 Dec 2024 20:38:50 +0000 Subject: [PATCH 15/29] IFS-49R2-SYNC: rebase cleanup --- src/ecwam/ctuw.F90 | 2 +- src/ecwam/wvwaminit.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ecwam/ctuw.F90 b/src/ecwam/ctuw.F90 index b17562926..94cf2fbcd 100644 --- a/src/ecwam/ctuw.F90 +++ b/src/ecwam/ctuw.F90 @@ -142,7 +142,7 @@ SUBROUTINE CTUW (DELPRO, MSTART, MEND, & !* LOOP OVER FREQUENCIES. ! ---------------------- -!$acc kernels !loop private(CGYP,KIJS,KIJL,CGX,IX,KY,UU,UREL,ISSU,VV,VREL,ISSV,DXP,DYP,ADXP,ADYP,DXUP,DXDW,DYUP,DYDW,DXX,DYY,GRIDAREAM1,WEIGHT) +!$acc kernels DO M = MSTART, MEND !* LOOP OVER DIRECTIONS. diff --git a/src/ecwam/wvwaminit.F90 b/src/ecwam/wvwaminit.F90 index 9a23e3f50..23a229615 100644 --- a/src/ecwam/wvwaminit.F90 +++ b/src/ecwam/wvwaminit.F90 @@ -36,7 +36,7 @@ SUBROUTINE WVWAMINIT (LLCOUPLED, IULOG, LLRNL, & USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU USE YOWMAP , ONLY : AMOSOP ,AMONOP ,IQGAUSS ,NGX ,NGY - USE YOWMPP , ONLY : IRANK ,NPROC ,KTAG + USE YOWMPP , ONLY : IRANK ,NPROC USE YOWPARAM , ONLY : KWAMVER ,LLUNSTR USE YOWTEST , ONLY : IU06 From 71d887312edefd6e330a0728329941d584f61d32 Mon Sep 17 00:00:00 2001 From: Ahmad Nawab Date: Mon, 2 Dec 2024 20:40:37 +0000 Subject: [PATCH 16/29] IFS-49R2-SYNC: set LWVFLX_SNL to TRUE --- share/ecwam/scripts/ecwam_run_model.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/share/ecwam/scripts/ecwam_run_model.sh b/share/ecwam/scripts/ecwam_run_model.sh index 69d292cbd..a1399b311 100755 --- a/share/ecwam/scripts/ecwam_run_model.sh +++ b/share/ecwam/scripts/ecwam_run_model.sh @@ -253,7 +253,7 @@ cat > wam_namelist << EOF LRSTPARALR = F, LRSTPARALW = F, LSECONDORDER = F, - LWVFLX_SNL = F, + LWVFLX_SNL = T, LLNORMWAMOUT = T, LLNORMWAMOUT_GLOBAL = T, CNORMWAMOUT_FILE = "statistics.log", From b544cab05f582eb1ccad04ce676d7db92c36f446 Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Fri, 4 Oct 2024 17:44:26 +0000 Subject: [PATCH 17/29] debug --- src/ecwam/findb.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/ecwam/findb.F90 b/src/ecwam/findb.F90 index 1ed9b0b14..e02ed39df 100644 --- a/src/ecwam/findb.F90 +++ b/src/ecwam/findb.F90 @@ -97,6 +97,9 @@ SUBROUTINE FINDB (NDIM, NBOUN, BLATB, BLNGB, IJARB, & !* 1.1 COMPUTE GRID MATRIX INDICES. ! ---------------------------- +!!!debile + write(*,* 'debile findb ',IRE,IO,BLATB(IO),BLNGB(IO),ILATS,ILATN + IOLT = NINT((BLATB(IO)-AMOSOP)/XDELLA+1.0_JWRB) ALONG = MOD(BLNGB(IO)-AMOWEP+720.0_JWRB,360.0_JWRB) IF (IOLT < ILATS .OR. IOLT > ILATN) THEN From 2f613e28344ff12762892143c99348903f6d4e5a Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Fri, 4 Oct 2024 21:59:00 +0000 Subject: [PATCH 18/29] debug --- src/ecwam/findb.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ecwam/findb.F90 b/src/ecwam/findb.F90 index e02ed39df..70160debe 100644 --- a/src/ecwam/findb.F90 +++ b/src/ecwam/findb.F90 @@ -98,7 +98,7 @@ SUBROUTINE FINDB (NDIM, NBOUN, BLATB, BLNGB, IJARB, & ! ---------------------------- !!!debile - write(*,* 'debile findb ',IRE,IO,BLATB(IO),BLNGB(IO),ILATS,ILATN + write(*,*) 'debile findb ',IRE,IO,BLATB(IO),BLNGB(IO),ILATS,ILATN IOLT = NINT((BLATB(IO)-AMOSOP)/XDELLA+1.0_JWRB) ALONG = MOD(BLNGB(IO)-AMOWEP+720.0_JWRB,360.0_JWRB) From 458d54917c5233dff834d9242e6799a9163dd65a Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Sun, 6 Oct 2024 10:53:29 +0000 Subject: [PATCH 19/29] debug --- src/ecwam/findb.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/ecwam/findb.F90 b/src/ecwam/findb.F90 index 70160debe..752bc1399 100644 --- a/src/ecwam/findb.F90 +++ b/src/ecwam/findb.F90 @@ -97,9 +97,6 @@ SUBROUTINE FINDB (NDIM, NBOUN, BLATB, BLNGB, IJARB, & !* 1.1 COMPUTE GRID MATRIX INDICES. ! ---------------------------- -!!!debile - write(*,*) 'debile findb ',IRE,IO,BLATB(IO),BLNGB(IO),ILATS,ILATN - IOLT = NINT((BLATB(IO)-AMOSOP)/XDELLA+1.0_JWRB) ALONG = MOD(BLNGB(IO)-AMOWEP+720.0_JWRB,360.0_JWRB) IF (IOLT < ILATS .OR. IOLT > ILATN) THEN @@ -125,6 +122,9 @@ SUBROUTINE FINDB (NDIM, NBOUN, BLATB, BLNGB, IJARB, & ENDIF ENDDO ENDDO +!!!debile + write(*,*) 'debile findb ',IRE,IO,BLATB(IO),BLNGB(IO),ILATS,ILATN,IOLG,IOLT,IJARB(IO) + ENDIF ENDDO From 8435b36b5b6b4c9868417275e5df4905fc837284 Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Sun, 6 Oct 2024 14:34:03 +0000 Subject: [PATCH 20/29] correct rearrngsar.F90 for JP = 0 cases --- src/ecwam/findb.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/ecwam/findb.F90 b/src/ecwam/findb.F90 index 752bc1399..1ed9b0b14 100644 --- a/src/ecwam/findb.F90 +++ b/src/ecwam/findb.F90 @@ -122,9 +122,6 @@ SUBROUTINE FINDB (NDIM, NBOUN, BLATB, BLNGB, IJARB, & ENDIF ENDDO ENDDO -!!!debile - write(*,*) 'debile findb ',IRE,IO,BLATB(IO),BLNGB(IO),ILATS,ILATN,IOLG,IOLT,IJARB(IO) - ENDIF ENDDO From 9877add4b62db569785f24262cf66e5c87914b49 Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Sun, 20 Oct 2024 15:11:29 +0000 Subject: [PATCH 21/29] fix issue with windesea directional spread when no windsea detected --- src/ecwam/outwint.F90 | 2 +- src/ecwam/sepwisw.F90 | 7 ++++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/ecwam/outwint.F90 b/src/ecwam/outwint.F90 index 2578ee7cf..e1f6b7adc 100644 --- a/src/ecwam/outwint.F90 +++ b/src/ecwam/outwint.F90 @@ -100,7 +100,7 @@ SUBROUTINE OUTWINT(BOUT) IFCST=IFCST/3600 ELSE WRITE(IU06,*) ' -----------------------------------------' - WRITE(IU06,*) ' ERROR in routine OUTINT :' + WRITE(IU06,*) ' ERROR in routine OUTWINT :' WRITE(IU06,*) ' forecast step must be multiple of hours!' WRITE(IU06,*) ' IFCST =', IFCST WRITE(IU06,*) ' CDATEF=', CDATEF diff --git a/src/ecwam/sepwisw.F90 b/src/ecwam/sepwisw.F90 index 8055a14d1..e3d4f49c1 100644 --- a/src/ecwam/sepwisw.F90 +++ b/src/ecwam/sepwisw.F90 @@ -271,7 +271,12 @@ SUBROUTINE SEPWISW (KIJS, KIJL, MIJ, FL1, XLLWS, CINV, & DO M=1,NFRE DO K=1,NANG DO IJ=KIJS,KIJL - F1(IJ,K,M)=MAX(FL1(IJ,K,M)-F1(IJ,K,M)+EPSMIN,0.0_JWRB) + !! add a small amount of noise in the wind direction + IF ( COSWDIF(IJ,K) > 0.8_JWRB .AND. M >= NFRE/2 ) THEN + F1(IJ,K,M)=MAX(FL1(IJ,K,M)-F1(IJ,K,M)+EPSMIN*COSWDIF(IJ,K)**4,0.0_JWRB) + ELSE + F1(IJ,K,M)=MAX(FL1(IJ,K,M)-F1(IJ,K,M),0.0_JWRB) + ENDIF ENDDO ENDDO ENDDO From d42bf58fa57f2e7530b2110c31450ed91c40ffa7 Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Sun, 3 Nov 2024 21:27:35 +0000 Subject: [PATCH 22/29] correct calling of w_maxh --- src/ecwam/outblock.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ecwam/outblock.F90 b/src/ecwam/outblock.F90 index a434f6243..6d1c250e6 100644 --- a/src/ecwam/outblock.F90 +++ b/src/ecwam/outblock.F90 @@ -531,8 +531,8 @@ SUBROUTINE OUTBLOCK (KIJS, KIJL, MIJ, & ENDIF !! alternative ways to determine wave height extremes - IF (IPFGTBL(63 + 3*NTRAIN + NTEWH) /= 0 .OR. IPFGTBL(64 + 3*NTRAIN + NTEWH) /= 0 .OR. & -& IPFGTBL(65 + 3*NTRAIN + NTEWH) /= 0 .OR. IPFGTBL(66 + 3*NTRAIN + NTEWH) /= 0 ) THEN + IF (IPFGTBL(64 + 3*NTRAIN + NTEWH) /= 0 .OR. IPFGTBL(65 + 3*NTRAIN + NTEWH) /= 0 .OR. & +& IPFGTBL(66 + 3*NTRAIN + NTEWH) /= 0 .OR. IPFGTBL(67 + 3*NTRAIN + NTEWH) /= 0 ) THEN CALL W_MAXH (KIJS, KIJL, FL1, DEPTH, WAVNUM, & & CMAX_F, HMAX_N, CMAX_ST, HMAX_ST, PHIST) ENDIF From bf91296a2c2eb9b7b05b7d1e9b9c48269127dc1e Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Wed, 20 Nov 2024 23:29:00 +0000 Subject: [PATCH 23/29] debug problem with call to MPL_ALLTOALLV in outwspec.F90 --- src/ecwam/outwspec.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/ecwam/outwspec.F90 b/src/ecwam/outwspec.F90 index 96115317a..c95369214 100644 --- a/src/ecwam/outwspec.F90 +++ b/src/ecwam/outwspec.F90 @@ -175,6 +175,8 @@ SUBROUTINE OUTWSPEC (IJS, IJL, SPEC, MARSTYPE, CDATE, CDATED, IFCST) ZRECVBUF(:)=0._JWRB ISTEP=NPROC +!!!debile +ISTEP=MAX(NPROC/10,1) DO IC=1,NN,ISTEP From 4e7e0dbf381f6d015af1c9db197636966abc864e Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Thu, 21 Nov 2024 10:34:07 +0000 Subject: [PATCH 24/29] debugging --- src/ecwam/outwspec.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/ecwam/outwspec.F90 b/src/ecwam/outwspec.F90 index c95369214..734589805 100644 --- a/src/ecwam/outwspec.F90 +++ b/src/ecwam/outwspec.F90 @@ -170,13 +170,14 @@ SUBROUTINE OUTWSPEC (IJS, IJL, SPEC, MARSTYPE, CDATE, CDATED, IFCST) WRITE(IU06,*) ' SPECTRA WRITTEN TO FILE ',OUTFILEN(1:LFILE) ENDIF -ALLOCATE(ZSENDBUF(NPROC*(NEND(IRANK)-NSTART(IRANK)+1))) +!!!!!ALLOCATE(ZSENDBUF(NPROC*(NEND(IRANK)-NSTART(IRANK)+1))) +!!!debile +ALLOCATE(ZSENDBUF((NEND(IRANK)-NSTART(IRANK)+1))) + ALLOCATE(ZRECVBUF(NEND(NPROC))) ZRECVBUF(:)=0._JWRB ISTEP=NPROC -!!!debile -ISTEP=MAX(NPROC/10,1) DO IC=1,NN,ISTEP From 3da4cba92c647e20afe8eac2e30b0def4c710794 Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Thu, 21 Nov 2024 11:24:56 +0000 Subject: [PATCH 25/29] test change to outwspec.F90 --- src/ecwam/outwspec.F90 | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/ecwam/outwspec.F90 b/src/ecwam/outwspec.F90 index 734589805..c1ae7ca30 100644 --- a/src/ecwam/outwspec.F90 +++ b/src/ecwam/outwspec.F90 @@ -170,10 +170,8 @@ SUBROUTINE OUTWSPEC (IJS, IJL, SPEC, MARSTYPE, CDATE, CDATED, IFCST) WRITE(IU06,*) ' SPECTRA WRITTEN TO FILE ',OUTFILEN(1:LFILE) ENDIF -!!!!!ALLOCATE(ZSENDBUF(NPROC*(NEND(IRANK)-NSTART(IRANK)+1))) -!!!debile -ALLOCATE(ZSENDBUF((NEND(IRANK)-NSTART(IRANK)+1))) - +!!!debile ALLOCATE(ZSENDBUF(NPROC*(NEND(IRANK)-NSTART(IRANK)+1))) +ALLOCATE(ZSENDBUF(MIN(NPROC,NN)*(NEND(IRANK)-NSTART(IRANK)+1))) ALLOCATE(ZRECVBUF(NEND(NPROC))) ZRECVBUF(:)=0._JWRB @@ -210,9 +208,9 @@ SUBROUTINE OUTWSPEC (IJS, IJL, SPEC, MARSTYPE, CDATE, CDATED, IFCST) ENDDO CALL GSTATS(692,0) - CALL MPL_ALLTOALLV(ZSENDBUF,ISENDCOUNTS, & - & ZRECVBUF,IRECVCOUNTS, & - & CDSTRING='OUTWSPEC:') + CALL MPL_ALLTOALLV(ZSENDBUF, ISENDCOUNTS, & + & ZRECVBUF, IRECVCOUNTS, & + & CDSTRING='OUTWSPEC:') CALL GSTATS(692,1) From 925c8b55d86636b96284ad9865687964e93b2f0c Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Thu, 21 Nov 2024 16:54:36 +0000 Subject: [PATCH 26/29] bug fix for outwspec.F90 for when NPROC > NANG*NFRE_RED --- src/ecwam/outwspec.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/ecwam/outwspec.F90 b/src/ecwam/outwspec.F90 index c1ae7ca30..8a0e9ffe4 100644 --- a/src/ecwam/outwspec.F90 +++ b/src/ecwam/outwspec.F90 @@ -170,8 +170,7 @@ SUBROUTINE OUTWSPEC (IJS, IJL, SPEC, MARSTYPE, CDATE, CDATED, IFCST) WRITE(IU06,*) ' SPECTRA WRITTEN TO FILE ',OUTFILEN(1:LFILE) ENDIF -!!!debile ALLOCATE(ZSENDBUF(NPROC*(NEND(IRANK)-NSTART(IRANK)+1))) -ALLOCATE(ZSENDBUF(MIN(NPROC,NN)*(NEND(IRANK)-NSTART(IRANK)+1))) +ALLOCATE(ZSENDBUF(MAXOUTTASK*(NEND(IRANK)-NSTART(IRANK)+1))) ALLOCATE(ZRECVBUF(NEND(NPROC))) ZRECVBUF(:)=0._JWRB From c5bb5ff4a3eb48ba7bd23aa80f5b6360c376550d Mon Sep 17 00:00:00 2001 From: Jean Bidlot Date: Fri, 29 Nov 2024 23:26:17 +0000 Subject: [PATCH 27/29] fix noise level for better MWP estimate under sea ice --- src/ecwam/outblock.F90 | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/src/ecwam/outblock.F90 b/src/ecwam/outblock.F90 index 6d1c250e6..99830a80a 100644 --- a/src/ecwam/outblock.F90 +++ b/src/ecwam/outblock.F90 @@ -63,8 +63,7 @@ SUBROUTINE OUTBLOCK (KIJS, KIJL, MIJ, & & NIPRMOUT, ITOBOUT ,NTEWH ,IPRMINFO USE YOWCOUP , ONLY : LWNEMOCOUSTRN USE YOWFRED , ONLY : FR, TH , DFIM, DELTH, COSTH, SINTH, XKMSS_CUTOFF - - + USE YOWICE , ONLY : FLMIN ,LICERUN ,LMASKICE USE YOWPARAM , ONLY : NANG ,NFRE USE YOWPCONS , ONLY : ZMISS ,DEG ,EPSUS ,EPSU10, G, ZPI USE YOWSTAT , ONLY : IREFRA @@ -133,12 +132,14 @@ SUBROUTINE OUTBLOCK (KIJS, KIJL, MIJ, & REAL(KIND=JWRB), DIMENSION(KIJL) :: ESEA ,FSEA ,THWISEA, P1SEA , P2SEA , SPRDSEA REAL(KIND=JWRB), DIMENSION(KIJL) :: CHARNOCK, BETAHQ, CDATM REAL(KIND=JWRB), DIMENSION(KIJL) :: HALP + REAL(KIND=JWRB), DIMENSION(KIJL) :: ZTHRS, ZRDUC REAL(KIND=JWRB), DIMENSION(KIJL,NTRAIN) :: EMTRAIN REAL(KIND=JWRB), DIMENSION(KIJL,NTRAIN) :: THTRAIN, PMTRAIN REAL(KIND=JWRB), DIMENSION(KIJL,NANG) :: COSWDIF ! *FL2ND* SPECTRUM with second order effect added if LSECONDORDER is true . -! and in the absolute frame of reference if currents are used +! and in the absolute frame of reference if currents are used +! and will have low frequency noise added if waves in sea-ice REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE) :: FL2ND LOGICAL :: LLPEAKF @@ -166,6 +167,26 @@ SUBROUTINE OUTBLOCK (KIJS, KIJL, MIJ, & ENDIF IF (LSECONDORDER) CALL CAL_SECOND_ORDER_SPEC(KIJS, KIJL, FL2ND, WAVNUM, DEPTH, SIG) + ! Adapting the noise level structure to be more consistent in sea ice conditions + IF (LICERUN .AND. .NOT. LMASKICE) THEN + DO IJ=KIJS,KIJL + ZTHRS(IJ) = (1._JWRB - 0.9_JWRB*MIN(CICOVER(IJ),0.99_JWRB))*FLMIN + ENDDO + + DO M=1,NFRE + DO IJ=KIJS,KIJL + ZRDUC(IJ) = EXP(-10.0_JWRB*FR(M)**2/SQRT(MAX(WSWAVE(IJ),1.0_JWRB))) + ENDDO + + DO K=1,NANG + DO IJ=KIJS,KIJL + IF (FL2ND(IJ,K,M) <= ZTHRS(IJ)) THEN + FL2ND(IJ,K,M) = MAX(ZRDUC(IJ) * FL2ND(IJ,K,M), ZTHRS(IJ)*ZRDUC(IJ)**2) + ENDIF + ENDDO + ENDDO + ENDDO + ENDIF ! COMPUTE MEAN PARAMETERS From 951f5966195deae872e8be8b02f5a81399181ffc Mon Sep 17 00:00:00 2001 From: Ahmad Nawab Date: Sun, 8 Dec 2024 14:13:48 +0000 Subject: [PATCH 28/29] WAVEMDL: fix bounds checking bug --- src/ecwam/wavemdl.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ecwam/wavemdl.F90 b/src/ecwam/wavemdl.F90 index 546820817..eed4e2fc9 100644 --- a/src/ecwam/wavemdl.F90 +++ b/src/ecwam/wavemdl.F90 @@ -975,7 +975,7 @@ SUBROUTINE WAVEMDL (CBEGDAT, PSTEP, KSTOP, KSTPW, & ALLOCATE(ZCOMCNT(NPROC)) ZCOMCNT=NCOMLOC CALL MPL_GATHERV(PSENDBUF=ZCOMBUFS(IST:IED),KROOT=IRECV, & - & PRECVBUF=ZCOMBUFR(:),KRECVCOUNTS=ZCOMCNT, & + & PRECVBUF=ZCOMBUFR,KRECVCOUNTS=ZCOMCNT, & & CDSTRING='WAVEMDL:') DEALLOCATE(ZCOMCNT) From 0cb198ca2c2ef3bf61c57132c864232df7072827 Mon Sep 17 00:00:00 2001 From: Ahmad Nawab Date: Mon, 9 Dec 2024 10:41:29 +0000 Subject: [PATCH 29/29] NVHPC: downgrade optimisation for W_MAXH --- src/ecwam/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ecwam/CMakeLists.txt b/src/ecwam/CMakeLists.txt index 9c67734ed..452c24615 100644 --- a/src/ecwam/CMakeLists.txt +++ b/src/ecwam/CMakeLists.txt @@ -485,7 +485,7 @@ elseif( CMAKE_Fortran_COMPILER_ID MATCHES GNU ) set_source_files_properties( mubuf.F90 PROPERTIES COMPILE_OPTIONS "-ffp-contract=off" ) elseif(CMAKE_Fortran_COMPILER_ID MATCHES "PGI|NVHPC" AND CMAKE_BUILD_TYPE MATCHES "Bit") set_source_files_properties( - sbottom.F90 PROPERTIES COMPILE_FLAGS " -g -O1 -Mflushz -Mno-signed-zeros " + w_maxh.F90 sbottom.F90 PROPERTIES COMPILE_FLAGS " -g -O1 -Mflushz -Mno-signed-zeros " ) set_source_files_properties( mubuf.F90 PROPERTIES COMPILE_OPTIONS "-Mnofma" ) if( HAVE_SINGLE_PRECISION )