- Timestamp:
- 2020-06-26T10:26:32+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement
- Files:
-
- 21 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@12931 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/CANAL/MY_SRC/stpctl.F90
r12377 r13159 19 19 USE dom_oce ! ocean space and time domain variables 20 20 USE c1d ! 1D vertical configuration 21 USE zdf_oce , ONLY : ln_zad_Aimp ! ocean vertical physics variables 22 USE wet_dry, ONLY : ll_wd, ssh_ref ! reference depth for negative bathy 23 ! 21 24 USE diawri ! Standard run outputs (dia_wri_state routine) 22 !23 25 USE in_out_manager ! I/O manager 24 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 27 USE lib_mpp ! distributed memory computing 26 USE zdf_oce , ONLY : ln_zad_Aimp ! ocean vertical physics variables 27 USE wet_dry, ONLY : ll_wd, ssh_ref ! reference depth for negative bathy 28 28 ! 29 29 USE netcdf ! NetCDF library 30 30 IMPLICIT NONE … … 33 33 PUBLIC stp_ctl ! routine called by step.F90 34 34 35 INTEGER :: idrun, idtime, idssh, idu, ids1, ids2, idt1, idt2, idc1, idw1, istatus36 LOGICAL :: lsomeoce35 INTEGER :: nrunid ! netcdf file id 36 INTEGER, DIMENSION(8) :: nvarid ! netcdf variable id 37 37 !!---------------------------------------------------------------------- 38 38 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 42 42 CONTAINS 43 43 44 SUBROUTINE stp_ctl( kt, K bb, Kmm, kindic)44 SUBROUTINE stp_ctl( kt, Kmm ) 45 45 !!---------------------------------------------------------------------- 46 46 !! *** ROUTINE stp_ctl *** … … 50 50 !! ** Method : - Save the time step in numstp 51 51 !! - Print it each 50 time steps 52 !! - Stop the run IF problem encountered by setting indic=-352 !! - Stop the run IF problem encountered by setting nstop > 0 53 53 !! Problems checked: |ssh| maximum larger than 10 m 54 54 !! |U| maximum larger than 10 m/s … … 57 57 !! ** Actions : "time.step" file = last ocean time-step 58 58 !! "run.stat" file = run statistics 59 !! nstop indicator sheared among all local domain (lk_mpp=T)59 !! nstop indicator sheared among all local domain 60 60 !!---------------------------------------------------------------------- 61 61 INTEGER, INTENT(in ) :: kt ! ocean time-step index 62 INTEGER, INTENT(in ) :: Kbb, Kmm ! ocean time level index 63 INTEGER, INTENT(inout) :: kindic ! error indicator 64 !! 65 INTEGER :: ji, jj, jk ! dummy loop indices 66 INTEGER, DIMENSION(2) :: ih ! min/max loc indices 67 INTEGER, DIMENSION(3) :: iu, is1, is2 ! min/max loc indices 68 REAL(wp) :: zzz ! local real 69 REAL(wp), DIMENSION(9) :: zmax 70 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 71 CHARACTER(len=20) :: clname 72 !!---------------------------------------------------------------------- 73 ! 74 ll_wrtstp = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 75 ll_colruns = ll_wrtstp .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) 76 ll_wrtruns = ll_colruns .AND. lwm 77 IF( kt == nit000 .AND. lwp ) THEN 78 WRITE(numout,*) 79 WRITE(numout,*) 'stp_ctl : time-stepping control' 80 WRITE(numout,*) '~~~~~~~' 81 ! ! open time.step file 82 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 83 ! ! open run.stat file(s) at start whatever 84 ! ! the value of sn_cfctl%ptimincr 85 IF( lwm .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) ) THEN 62 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 63 !! 64 INTEGER :: ji ! dummy loop indices 65 INTEGER :: idtime, istatus 66 INTEGER , DIMENSION(9) :: iareasum, iareamin, iareamax 67 INTEGER , DIMENSION(3,4) :: iloc ! min/max loc indices 68 REAL(wp) :: zzz ! local real 69 REAL(wp), DIMENSION(9) :: zmax, zmaxlocal 70 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 71 LOGICAL, DIMENSION(jpi,jpj,jpk) :: llmsk 72 CHARACTER(len=20) :: clname 73 !!---------------------------------------------------------------------- 74 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 75 ! 76 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 77 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 78 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 79 ! 80 IF( kt == nit000 ) THEN 81 ! 82 IF( lwp ) THEN 83 WRITE(numout,*) 84 WRITE(numout,*) 'stp_ctl : time-stepping control' 85 WRITE(numout,*) '~~~~~~~' 86 ENDIF 87 ! ! open time.step ascii file, done only by 1st subdomain 88 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 89 ! 90 IF( ll_wrtruns ) THEN 91 ! ! open run.stat ascii file, done only by 1st subdomain 86 92 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 93 ! ! open run.stat.nc netcdf file, done only by 1st subdomain 87 94 clname = 'run.stat.nc' 88 95 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 89 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun)90 istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime )91 istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh)92 istatus = NF90_DEF_VAR( idrun, 'abs_u_max', NF90_DOUBLE, (/ idtime /), idu)93 istatus = NF90_DEF_VAR( idrun, 's_min', NF90_DOUBLE, (/ idtime /), ids1)94 istatus = NF90_DEF_VAR( idrun, 's_max', NF90_DOUBLE, (/ idtime /), ids2)95 istatus = NF90_DEF_VAR( idrun, 't_min', NF90_DOUBLE, (/ idtime /), idt1)96 istatus = NF90_DEF_VAR( idrun, 't_max', NF90_DOUBLE, (/ idtime /), idt2)96 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 97 istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 98 istatus = NF90_DEF_VAR( nrunid, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), nvarid(1) ) 99 istatus = NF90_DEF_VAR( nrunid, 'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 100 istatus = NF90_DEF_VAR( nrunid, 's_min', NF90_DOUBLE, (/ idtime /), nvarid(3) ) 101 istatus = NF90_DEF_VAR( nrunid, 's_max', NF90_DOUBLE, (/ idtime /), nvarid(4) ) 102 istatus = NF90_DEF_VAR( nrunid, 't_min', NF90_DOUBLE, (/ idtime /), nvarid(5) ) 103 istatus = NF90_DEF_VAR( nrunid, 't_max', NF90_DOUBLE, (/ idtime /), nvarid(6) ) 97 104 IF( ln_zad_Aimp ) THEN 98 istatus = NF90_DEF_VAR( idrun, 'abs_wi_max', NF90_DOUBLE, (/ idtime /), idw1)99 istatus = NF90_DEF_VAR( idrun, 'Cu_max', NF90_DOUBLE, (/ idtime /), idc1)105 istatus = NF90_DEF_VAR( nrunid, 'Cf_max', NF90_DOUBLE, (/ idtime /), nvarid(7) ) 106 istatus = NF90_DEF_VAR( nrunid,'abs_wi_max',NF90_DOUBLE, (/ idtime /), nvarid(8) ) 100 107 ENDIF 101 istatus = NF90_ENDDEF(idrun) 102 zmax(8:9) = 0._wp ! initialise to zero in case ln_zad_Aimp option is not in use 103 ENDIF 104 ENDIF 105 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 106 ! 107 IF(lwm .AND. ll_wrtstp) THEN !== current time step ==! ("time.step" file) 108 istatus = NF90_ENDDEF(nrunid) 109 ENDIF 110 ! 111 ENDIF 112 ! 113 ! !== write current time step ==! 114 ! !== done only by 1st subdomain at writting timestep ==! 115 IF( lwm .AND. ll_wrtstp ) THEN 108 116 WRITE ( numstp, '(1x, i8)' ) kt 109 117 REWIND( numstp ) 110 118 ENDIF 111 ! 112 ! !== test of extrema ==! 113 IF( ll_wd ) THEN 114 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref*tmask(:,:,1) ) ) ! ssh max 115 ELSE 116 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) ) ) ! ssh max 117 ENDIF 118 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) ) ! velocity max (zonal only) 119 zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! minus salinity max 120 zmax(4) = MAXVAL( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! salinity max 121 zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! minus temperature max 122 zmax(6) = MAXVAL( ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! temperature max 123 zmax(7) = REAL( nstop , wp ) ! stop indicator 124 IF( ln_zad_Aimp ) THEN 125 zmax(8) = MAXVAL( ABS( wi(:,:,:) ) , mask = wmask(:,:,:) == 1._wp ) ! implicit vertical vel. max 126 zmax(9) = MAXVAL( Cu_adv(:,:,:) , mask = tmask(:,:,:) == 1._wp ) ! cell Courant no. max 127 ENDIF 128 ! 119 ! !== test of local extrema ==! 120 ! !== done by all processes at every time step ==! 121 ! 122 ! define zmax default value. needed for land processors 123 IF( ll_colruns ) THEN ! default value: must not be kept when calling mpp_max -> must be as small as possible 124 zmax(:) = -HUGE(1._wp) 125 ELSE ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 126 zmax(:) = 0._wp 127 zmax(3) = -1._wp ! avoid salinity minimum at 0. 128 ENDIF 129 ! 130 llmsk(:,:,1) = ssmask(:,:) == 1._wp 131 IF( COUNT( llmsk(:,:,1) ) > 0 ) THEN ! avoid huge values sent back for land processors... 132 IF( ll_wd ) THEN 133 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) ) ! ssh max 134 ELSE 135 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) ), mask = llmsk(:,:,1) ) ! ssh max 136 ENDIF 137 ENDIF 138 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) ) ! velocity max (zonal only) 139 llmsk(:,:,:) = tmask(:,:,:) == 1._wp 140 IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 141 zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! minus salinity max 142 zmax(4) = MAXVAL( ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! salinity max 143 IF( ll_colruns .OR. jpnij == 1 ) THEN ! following variables are used only in the netcdf file 144 zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! minus temperature max 145 zmax(6) = MAXVAL( ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! temperature max 146 IF( ln_zad_Aimp ) THEN 147 zmax(7) = MAXVAL( Cu_adv(:,:,:) , mask = llmsk ) ! partitioning coeff. max 148 llmsk(:,:,:) = wmask(:,:,:) == 1._wp 149 IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 150 zmax(8) = MAXVAL(ABS( wi(:,:,:) ), mask = llmsk ) ! implicit vertical vel. max 151 ENDIF 152 ENDIF 153 ENDIF 154 ENDIF 155 zmax(9) = REAL( nstop, wp ) ! stop indicator 156 ! !== get global extrema ==! 157 ! !== done by all processes if writting run.stat ==! 129 158 IF( ll_colruns ) THEN 159 zmaxlocal(:) = zmax(:) 130 160 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 131 nstop = NINT( zmax(7) ) ! nstop indicator sheared among all local domains 132 ENDIF 133 ! !== run statistics ==! ("run.stat" files) 161 nstop = NINT( zmax(9) ) ! update nstop indicator (now sheared among all local domains) 162 ENDIF 163 ! !== write "run.stat" files ==! 164 ! !== done only by 1st subdomain at writting timestep ==! 134 165 IF( ll_wrtruns ) THEN 135 166 WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 136 istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) )137 istatus = NF90_PUT_VAR( idrun, idu, (/ zmax(2)/), (/kt/), (/1/) )138 istatus = NF90_PUT_VAR( idrun, ids1, (/-zmax(3)/), (/kt/), (/1/) )139 istatus = NF90_PUT_VAR( idrun, ids2, (/ zmax(4)/), (/kt/), (/1/) )140 istatus = NF90_PUT_VAR( idrun, idt1, (/-zmax(5)/), (/kt/), (/1/) )141 istatus = NF90_PUT_VAR( idrun, idt2, (/ zmax(6)/), (/kt/), (/1/) )167 istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 168 istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 169 istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) ) 170 istatus = NF90_PUT_VAR( nrunid, nvarid(4), (/ zmax(4)/), (/kt/), (/1/) ) 171 istatus = NF90_PUT_VAR( nrunid, nvarid(5), (/-zmax(5)/), (/kt/), (/1/) ) 172 istatus = NF90_PUT_VAR( nrunid, nvarid(6), (/ zmax(6)/), (/kt/), (/1/) ) 142 173 IF( ln_zad_Aimp ) THEN 143 istatus = NF90_PUT_VAR( idrun, idw1, (/ zmax(8)/), (/kt/), (/1/) ) 144 istatus = NF90_PUT_VAR( idrun, idc1, (/ zmax(9)/), (/kt/), (/1/) ) 145 ENDIF 146 IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 147 IF( kt == nitend ) istatus = NF90_CLOSE(idrun) 174 istatus = NF90_PUT_VAR( nrunid, nvarid(7), (/ zmax(7)/), (/kt/), (/1/) ) 175 istatus = NF90_PUT_VAR( nrunid, nvarid(8), (/ zmax(8)/), (/kt/), (/1/) ) 176 ENDIF 177 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 148 178 END IF 149 ! !== error handling ==! 150 IF( ( ln_ctl .OR. lsomeoce ) .AND. ( & ! have use mpp_max (because ln_ctl=.T.) or contains some ocean points 151 & zmax(1) > 20._wp .OR. & ! too large sea surface height ( > 20 m ) 152 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 153 !!$ & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity 154 !!$ & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 155 !!$ & zmax(4) < 0._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 156 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN ! NaN encounter in the tests 157 IF( lk_mpp .AND. ln_ctl ) THEN 158 CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,Kmm)) , ssmask(:,:) , zzz, ih ) 159 CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm)) , umask (:,:,:), zzz, iu ) 160 CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is1 ) 161 CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is2 ) 179 ! !== error handling ==! 180 ! !== done by all processes at every time step ==! 181 ! 182 IF( zmax(1) > 20._wp .OR. & ! too large sea surface height ( > 20 m ) 183 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 184 !!$ & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity 185 !!$ & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 186 !!$ & zmax(4) < 0._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 187 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests 188 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 189 ! 190 iloc(:,:) = 0 191 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 192 ! first: close the netcdf file, so we can read it 193 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid) 194 ! get global loc on the min/max 195 CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:, Kmm)), ssmask(:,: ), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 196 CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:, Kmm)), umask(:,:,:), zzz, iloc(1:3,2) ) 197 CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , tmask(:,:,:), zzz, iloc(1:3,3) ) 198 CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , tmask(:,:,:), zzz, iloc(1:3,4) ) 199 ! find which subdomain has the max. 200 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 201 DO ji = 1, 9 202 IF( zmaxlocal(ji) == zmax(ji) ) THEN 203 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 204 ENDIF 205 END DO 206 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain 207 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain 208 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain 209 ELSE ! find local min and max locations: 210 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 211 iloc(1:2,1) = MAXLOC( ABS( ssh(:,:, Kmm)), mask = ssmask(:,: ) == 1._wp ) + (/ nimpp - 1, njmpp - 1 /) 212 iloc(1:3,2) = MAXLOC( ABS( uu(:,:,:, Kmm)), mask = umask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 213 iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 214 iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 215 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 216 ENDIF 217 ! 218 WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m or |U| > 10 m/s or S <= 0 or S >= 100 or NaN encounter in the tests' 219 CALL wrt_line( ctmp2, kt, '|ssh| max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 220 CALL wrt_line( ctmp3, kt, '|U| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 221 CALL wrt_line( ctmp4, kt, 'Sal min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 222 CALL wrt_line( ctmp5, kt, 'Sal max', zmax(4), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) ) 223 IF( Agrif_Root() ) THEN 224 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' 162 225 ELSE 163 ih(:) = MAXLOC( ABS( ssh(:,:,Kmm) ) ) + (/ nimpp - 1, njmpp - 1 /) 164 iu(:) = MAXLOC( ABS( uu (:,:,:,Kmm) ) ) + (/ nimpp - 1, njmpp - 1, 0 /) 165 is1(:) = MINLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 166 is2(:) = MAXLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 167 ENDIF 168 169 WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m or |U| > 10 m/s or S <= 0 or S >= 100 or NaN encounter in the tests' 170 WRITE(ctmp2,9100) kt, zmax(1), ih(1) , ih(2) 171 WRITE(ctmp3,9200) kt, zmax(2), iu(1) , iu(2) , iu(3) 172 WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 173 WRITE(ctmp5,9400) kt, zmax(4), is2(1), is2(2), is2(3) 174 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort.nc file' 175 226 WRITE(ctmp6,*) ' ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 227 ENDIF 228 ! 176 229 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 177 178 IF( .NOT. ln_ctl ) THEN179 WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea180 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6)181 ELSE182 CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' )183 ENDIF184 185 kindic = -3186 !187 ENDIF188 !189 9100 FORMAT (' kt=',i8,' |ssh| max: ',1pg11.4,', at i j : ',2i5) 190 9200 FORMAT (' kt=',i8,' |U| max: ',1pg11.4,', at i j k: ',3i5) 191 9300 FORMAT (' kt=',i8,' S min: ',1pg11.4,', at i j k: ',3i5) 192 9400 FORMAT (' kt=',i8,' S max: ',1pg11.4,', at i j k: ',3i5) 230 ! 231 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 232 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 233 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) 234 ENDIF 235 ELSE ! only mpi subdomains with errors are here -> STOP now 236 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 237 ENDIF 238 ! 239 ENDIF 240 ! 241 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... 242 ngrdstop = Agrif_Fixed() ! store which grid got this error 243 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock 244 ENDIF 245 ! 193 246 9500 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 194 247 ! 195 248 END SUBROUTINE stp_ctl 249 250 251 SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 252 !!---------------------------------------------------------------------- 253 !! *** ROUTINE wrt_line *** 254 !! 255 !! ** Purpose : write information line 256 !! 257 !!---------------------------------------------------------------------- 258 CHARACTER(len=*), INTENT( out) :: cdline 259 CHARACTER(len=*), INTENT(in ) :: cdprefix 260 REAL(wp), INTENT(in ) :: pval 261 INTEGER, DIMENSION(3), INTENT(in ) :: kloc 262 INTEGER, INTENT(in ) :: kt, ksum, kmin, kmax 263 ! 264 CHARACTER(len=80) :: clsuff 265 CHARACTER(len=9 ) :: clkt, clsum, clmin, clmax 266 CHARACTER(len=9 ) :: cli, clj, clk 267 CHARACTER(len=1 ) :: clfmt 268 CHARACTER(len=4 ) :: cl4 ! needed to be able to compile with Agrif, I don't know why 269 INTEGER :: ifmtk 270 !!---------------------------------------------------------------------- 271 WRITE(clkt , '(i9)') kt 272 273 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij ,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 274 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF 275 cl4 = '(i'//clfmt//')' ; WRITE(clsum, cl4) ksum 276 WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 277 cl4 = '(i'//clfmt//')' ; WRITE(clmin, cl4) kmin-1 278 WRITE(clmax, cl4) kmax-1 279 ! 280 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1 ! how many digits to we need to write jpiglo? (we decide max = 9) 281 cl4 = '(i'//clfmt//')' ; WRITE(cli, cl4) kloc(1) ! this is ok with AGRIF 282 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1 ! how many digits to we need to write jpjglo? (we decide max = 9) 283 cl4 = '(i'//clfmt//')' ; WRITE(clj, cl4) kloc(2) ! this is ok with AGRIF 284 ! 285 IF( ksum == 1 ) THEN ; WRITE(clsuff,9100) TRIM(clmin) 286 ELSE ; WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 287 ENDIF 288 IF(kloc(3) == 0) THEN 289 ifmtk = INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 290 clk = REPEAT(' ', ifmtk) ! create the equivalent in blank string 291 WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 292 ELSE 293 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 294 !!! WRITE(clk, '(i'//clfmt//')') kloc(3) ! this is creating a compilation error with AGRIF 295 cl4 = '(i'//clfmt//')' ; WRITE(clk, cl4) kloc(3) ! this is ok with AGRIF 296 WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), TRIM(clk), TRIM(clsuff) 297 ENDIF 298 ! 299 9100 FORMAT('MPI rank ', a) 300 9200 FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 301 9300 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j ', a, ' ', a, ' ', a, ' ', a) 302 9400 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 303 ! 304 END SUBROUTINE wrt_line 305 196 306 197 307 !!====================================================================== -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/EXPREF/file_def_nemo-oce.xml
r11889 r13159 21 21 <file_group id="5d" output_freq="5d" output_level="10" enabled=".TRUE."> <!-- 5d files --> 22 22 23 <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 24 <file id="file1" output_freq="1mo" name_suffix="_grid_T" description="ocean T grid variables" > 25 <field field_ref="toce" name="votemper" /> 26 <field field_ref="soce" name="vosaline" /> 27 <field field_ref="ssh" name="sossheig" /> 23 <file id="file1" output_freq="5d" name_suffix="_grid_T" description="ocean T grid variables" > 24 <field field_ref="toce" name="votemper" operation="average" freq_op="5d" > @toce_e3t / @e3t </field> 25 <field field_ref="soce" name="vosaline" operation="average" freq_op="5d" > @soce_e3t / @e3t </field> 26 <field field_ref="ssh" name="sossheig" /> 28 27 <!-- variable for ice shelf --> 29 <field field_ref="fwfisf_cav" 30 <field field_ref="isfgammat" 31 <field field_ref="isfgammas" 28 <field field_ref="fwfisf_cav" name="sowflisf" /> 29 <field field_ref="isfgammat" name="sogammat" /> 30 <field field_ref="isfgammas" name="sogammas" /> 32 31 <field field_ref="ttbl_cav" name="ttbl" /> 33 <field field_ref="stbl" name="stbl" />34 <field field_ref="utbl" name="utbl" />35 <field field_ref="vtbl" name="vtbl" />32 <field field_ref="stbl" name="stbl" /> 33 <field field_ref="utbl" name="utbl" /> 34 <field field_ref="vtbl" name="vtbl" /> 36 35 </file> 37 <file id="file2" output_freq=" 1mo" name_suffix="_grid_U" description="ocean U grid variables" >38 <field field_ref="uoce" name="vozocrtx" />36 <file id="file2" output_freq="5d" name_suffix="_grid_U" description="ocean U grid variables" > 37 <field field_ref="uoce" name="vozocrtx" operation="average" freq_op="5d" > @uoce_e3u / @e3u </field> /> 39 38 </file> 40 <file id="file3" output_freq=" 1mo" name_suffix="_grid_V" description="ocean V grid variables" >41 <field field_ref="voce" name="vomecrty" />39 <file id="file3" output_freq="5d" name_suffix="_grid_V" description="ocean V grid variables" > 40 <field field_ref="voce" name="vomecrty" operation="average" freq_op="5d" > @voce_e3v / @e3v </field> /> 42 41 </file> 43 42 </file_group> 43 44 <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 44 45 <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files --> 45 46 <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files --> -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/EXPREF/namelist_cfg
r12489 r13159 114 114 115 115 ln_usr = .true. ! user defined formulation (T => check usrdef_sbc) 116 nn_fwb = 1116 nn_fwb = 4 117 117 / 118 118 !----------------------------------------------------------------------- … … 308 308 &nameos ! ocean Equation Of Seawater (default: NO selection) 309 309 !----------------------------------------------------------------------- 310 ln_teos10 = .false. ! = Use TEOS-10 311 ln_eos80 = .false. ! = Use EOS80 312 ln_leos = .true. ! = Use S-EOS (simplified Eq.) 310 ln_leos = .true. ! = Use L-EOS (linear Eq.) 313 311 ! 314 312 ! ! S-EOS coefficients (ln_seos=T): -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/MY_SRC/dtatsd.F90
r12077 r13159 36 36 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tsddmp ! structure of input SST (file informations, fields read) 37 37 38 !! * Substitutions 39 # include "do_loop_substitute.h90" 38 40 !!---------------------------------------------------------------------- 39 41 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 67 69 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 68 70 ! 69 REWIND( numnam_ref ) ! Namelist namtsd in reference namelist :70 71 READ ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901) 71 72 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in reference namelist' ) 72 REWIND( numnam_cfg ) ! Namelist namtsd in configuration namelist : Parameters of the run73 73 READ ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 ) 74 74 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtsd in configuration namelist' ) … … 191 191 ENDIF 192 192 ! 193 DO jj = 1, jpj ! vertical interpolation of T & S 194 DO ji = 1, jpi 195 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 196 zl = gdept_0(ji,jj,jk) 197 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 198 ztp(jk) = ptsd(ji,jj,1 ,jp_tem) 199 zsp(jk) = ptsd(ji,jj,1 ,jp_sal) 200 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 201 ztp(jk) = ptsd(ji,jj,jpkm1,jp_tem) 202 zsp(jk) = ptsd(ji,jj,jpkm1,jp_sal) 203 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 204 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 205 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 206 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 207 ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 208 zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 209 ENDIF 210 END DO 211 ENDIF 212 END DO 213 DO jk = 1, jpkm1 214 ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 215 ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk) 216 END DO 217 ptsd(ji,jj,jpk,jp_tem) = 0._wp 218 ptsd(ji,jj,jpk,jp_sal) = 0._wp 193 DO_2D_11_11 194 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 195 zl = gdept_0(ji,jj,jk) 196 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 197 ztp(jk) = ptsd(ji,jj,1 ,jp_tem) 198 zsp(jk) = ptsd(ji,jj,1 ,jp_sal) 199 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 200 ztp(jk) = ptsd(ji,jj,jpkm1,jp_tem) 201 zsp(jk) = ptsd(ji,jj,jpkm1,jp_sal) 202 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 203 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 204 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 205 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 206 ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 207 zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 208 ENDIF 209 END DO 210 ENDIF 219 211 END DO 220 END DO 212 DO jk = 1, jpkm1 213 ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 214 ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk) 215 END DO 216 ptsd(ji,jj,jpk,jp_tem) = 0._wp 217 ptsd(ji,jj,jpk,jp_sal) = 0._wp 218 END_2D 221 219 ! 222 220 ELSE !== z- or zps- coordinate ==! … … 226 224 ! 227 225 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 228 DO jj = 1, jpj 229 DO ji = 1, jpi 230 ik = mbkt(ji,jj) 231 IF( ik > 1 ) THEN 232 zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 233 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem) 234 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal) 235 ENDIF 236 ik = mikt(ji,jj) 237 IF( ik > 1 ) THEN 238 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 239 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 240 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal) 241 END IF 242 END DO 243 END DO 226 DO_2D_11_11 227 ik = mbkt(ji,jj) 228 IF( ik > 1 ) THEN 229 zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 230 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem) 231 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal) 232 ENDIF 233 ik = mikt(ji,jj) 234 IF( ik > 1 ) THEN 235 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 236 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 237 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal) 238 END IF 239 END_2D 244 240 ENDIF 245 241 ! -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/MY_SRC/eosbn2.F90
r12489 r13159 180 180 REAL(wp) :: BPE002 181 181 182 !! * Substitutions 183 # include "do_loop_substitute.h90" 182 184 !!---------------------------------------------------------------------- 183 185 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 241 243 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 242 244 ! 243 DO jk = 1, jpkm1 244 DO jj = 1, jpj 245 DO ji = 1, jpi 246 ! 247 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 248 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 249 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 250 ztm = tmask(ji,jj,jk) ! tmask 245 DO_3D_11_11( 1, jpkm1 ) 246 ! 247 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 248 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 249 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 250 ztm = tmask(ji,jj,jk) ! tmask 251 ! 252 zn3 = EOS013*zt & 253 & + EOS103*zs+EOS003 254 ! 255 zn2 = (EOS022*zt & 256 & + EOS112*zs+EOS012)*zt & 257 & + (EOS202*zs+EOS102)*zs+EOS002 258 ! 259 zn1 = (((EOS041*zt & 260 & + EOS131*zs+EOS031)*zt & 261 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 262 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 263 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 264 ! 265 zn0 = (((((EOS060*zt & 266 & + EOS150*zs+EOS050)*zt & 267 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 268 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 269 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 270 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 271 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 272 ! 273 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 274 ! 275 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 276 ! 277 END_3D 278 ! 279 CASE( np_seos ) !== simplified EOS ==! 280 ! 281 DO_3D_11_11( 1, jpkm1 ) 282 zt = pts (ji,jj,jk,jp_tem) - 10._wp 283 zs = pts (ji,jj,jk,jp_sal) - 35._wp 284 zh = pdep (ji,jj,jk) 285 ztm = tmask(ji,jj,jk) 286 ! 287 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 288 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 289 & - rn_nu * zt * zs 290 ! 291 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 292 END_3D 293 ! 294 CASE( np_leos ) !== linear ISOMIP EOS ==! 295 ! 296 DO_3D_11_11( 1, jpkm1 ) 297 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 298 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp 299 zh = pdep (ji,jj,jk) 300 ztm = tmask(ji,jj,jk) 301 ! 302 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 303 ! 304 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 305 END_3D 306 ! 307 END SELECT 308 ! 309 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu : ', kdim=jpk ) 310 ! 311 IF( ln_timing ) CALL timing_stop('eos-insitu') 312 ! 313 END SUBROUTINE eos_insitu 314 315 316 SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 317 !!---------------------------------------------------------------------- 318 !! *** ROUTINE eos_insitu_pot *** 319 !! 320 !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the 321 !! potential volumic mass (Kg/m3) from potential temperature and 322 !! salinity fields using an equation of state selected in the 323 !! namelist. 324 !! 325 !! ** Action : - prd , the in situ density (no units) 326 !! - prhop, the potential volumic mass (Kg/m3) 327 !! 328 !!---------------------------------------------------------------------- 329 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 330 ! ! 2 : salinity [psu] 331 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 332 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prhop ! potential density (surface referenced) 333 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 334 ! 335 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices 336 INTEGER :: jdof 337 REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars 338 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 339 REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors 340 !!---------------------------------------------------------------------- 341 ! 342 IF( ln_timing ) CALL timing_start('eos-pot') 343 ! 344 SELECT CASE ( neos ) 345 ! 346 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 347 ! 348 ! Stochastic equation of state 349 IF ( ln_sto_eos ) THEN 350 ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 351 ALLOCATE(zn_sto(1:2*nn_sto_eos)) 352 ALLOCATE(zsign(1:2*nn_sto_eos)) 353 DO jsmp = 1, 2*nn_sto_eos, 2 354 zsign(jsmp) = 1._wp 355 zsign(jsmp+1) = -1._wp 356 END DO 357 ! 358 DO_3D_11_11( 1, jpkm1 ) 359 ! 360 ! compute density (2*nn_sto_eos) times: 361 ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 362 ! (2) for t-dt, s-ds (with the opposite fluctuation) 363 DO jsmp = 1, nn_sto_eos*2 364 jdof = (jsmp + 1) / 2 365 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 366 zt = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0 ! temperature 367 zstemp = pts (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 368 zs = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 ) ! square root salinity 369 ztm = tmask(ji,jj,jk) ! tmask 251 370 ! 252 371 zn3 = EOS013*zt & … … 263 382 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 264 383 ! 265 zn0 = (((((EOS060*zt &384 zn0_sto(jsmp) = (((((EOS060*zt & 266 385 & + EOS150*zs+EOS050)*zt & 267 386 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & … … 271 390 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 272 391 ! 273 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 392 zn_sto(jsmp) = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 393 END DO 394 ! 395 ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 396 prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 397 DO jsmp = 1, nn_sto_eos*2 398 prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp) ! potential density referenced at the surface 274 399 ! 275 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 276 ! 400 prd(ji,jj,jk) = prd(ji,jj,jk) + ( zn_sto(jsmp) * r1_rho0 - 1._wp ) ! density anomaly (masked) 277 401 END DO 278 END DO 279 END DO 280 ! 281 CASE( np_seos ) !== simplified EOS ==! 282 ! 283 DO jk = 1, jpkm1 284 DO jj = 1, jpj 285 DO ji = 1, jpi 286 zt = pts (ji,jj,jk,jp_tem) - 10._wp 287 zs = pts (ji,jj,jk,jp_sal) - 35._wp 288 zh = pdep (ji,jj,jk) 289 ztm = tmask(ji,jj,jk) 290 ! 291 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 292 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 293 & - rn_nu * zt * zs 294 ! 295 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 296 END DO 297 END DO 298 END DO 299 ! 300 CASE( np_leos ) !== linear ISOMIP EOS ==! 301 ! 302 DO jk = 1, jpkm1 303 DO jj = 1, jpj 304 DO ji = 1, jpi 305 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 306 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp 307 zh = pdep (ji,jj,jk) 308 ztm = tmask(ji,jj,jk) 309 ! 310 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 311 ! 312 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 313 END DO 314 END DO 315 END DO 316 ! 317 END SELECT 318 ! 319 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu : ', kdim=jpk ) 320 ! 321 IF( ln_timing ) CALL timing_stop('eos-insitu') 322 ! 323 END SUBROUTINE eos_insitu 324 325 326 SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 327 !!---------------------------------------------------------------------- 328 !! *** ROUTINE eos_insitu_pot *** 329 !! 330 !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the 331 !! potential volumic mass (Kg/m3) from potential temperature and 332 !! salinity fields using an equation of state selected in the 333 !! namelist. 334 !! 335 !! ** Action : - prd , the in situ density (no units) 336 !! - prhop, the potential volumic mass (Kg/m3) 337 !! 338 !!---------------------------------------------------------------------- 339 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 340 ! ! 2 : salinity [psu] 341 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 342 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prhop ! potential density (surface referenced) 343 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 344 ! 345 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices 346 INTEGER :: jdof 347 REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars 348 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 349 REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors 350 !!---------------------------------------------------------------------- 351 ! 352 IF( ln_timing ) CALL timing_start('eos-pot') 353 ! 354 SELECT CASE ( neos ) 355 ! 356 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 357 ! 358 ! Stochastic equation of state 359 IF ( ln_sto_eos ) THEN 360 ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 361 ALLOCATE(zn_sto(1:2*nn_sto_eos)) 362 ALLOCATE(zsign(1:2*nn_sto_eos)) 363 DO jsmp = 1, 2*nn_sto_eos, 2 364 zsign(jsmp) = 1._wp 365 zsign(jsmp+1) = -1._wp 366 END DO 367 ! 368 DO jk = 1, jpkm1 369 DO jj = 1, jpj 370 DO ji = 1, jpi 371 ! 372 ! compute density (2*nn_sto_eos) times: 373 ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 374 ! (2) for t-dt, s-ds (with the opposite fluctuation) 375 DO jsmp = 1, nn_sto_eos*2 376 jdof = (jsmp + 1) / 2 377 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 378 zt = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0 ! temperature 379 zstemp = pts (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 380 zs = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 ) ! square root salinity 381 ztm = tmask(ji,jj,jk) ! tmask 382 ! 383 zn3 = EOS013*zt & 384 & + EOS103*zs+EOS003 385 ! 386 zn2 = (EOS022*zt & 387 & + EOS112*zs+EOS012)*zt & 388 & + (EOS202*zs+EOS102)*zs+EOS002 389 ! 390 zn1 = (((EOS041*zt & 391 & + EOS131*zs+EOS031)*zt & 392 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 393 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 394 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 395 ! 396 zn0_sto(jsmp) = (((((EOS060*zt & 397 & + EOS150*zs+EOS050)*zt & 398 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 399 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 400 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 401 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 402 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 403 ! 404 zn_sto(jsmp) = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 405 END DO 406 ! 407 ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 408 prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 409 DO jsmp = 1, nn_sto_eos*2 410 prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp) ! potential density referenced at the surface 411 ! 412 prd(ji,jj,jk) = prd(ji,jj,jk) + ( zn_sto(jsmp) * r1_rho0 - 1._wp ) ! density anomaly (masked) 413 END DO 414 prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 415 prd (ji,jj,jk) = 0.5_wp * prd (ji,jj,jk) * ztm / nn_sto_eos 416 END DO 417 END DO 418 END DO 402 prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 403 prd (ji,jj,jk) = 0.5_wp * prd (ji,jj,jk) * ztm / nn_sto_eos 404 END_3D 419 405 DEALLOCATE(zn0_sto,zn_sto,zsign) 420 406 ! Non-stochastic equation of state 421 407 ELSE 422 DO jk = 1, jpkm1 423 DO jj = 1, jpj 424 DO ji = 1, jpi 425 ! 426 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 427 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 428 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 429 ztm = tmask(ji,jj,jk) ! tmask 430 ! 431 zn3 = EOS013*zt & 432 & + EOS103*zs+EOS003 433 ! 434 zn2 = (EOS022*zt & 435 & + EOS112*zs+EOS012)*zt & 436 & + (EOS202*zs+EOS102)*zs+EOS002 437 ! 438 zn1 = (((EOS041*zt & 439 & + EOS131*zs+EOS031)*zt & 440 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 441 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 442 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 443 ! 444 zn0 = (((((EOS060*zt & 445 & + EOS150*zs+EOS050)*zt & 446 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 447 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 448 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 449 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 450 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 451 ! 452 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 453 ! 454 prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface 455 ! 456 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 457 END DO 458 END DO 459 END DO 460 ENDIF 461 462 CASE( np_seos ) !== simplified EOS ==! 463 ! 464 DO jk = 1, jpkm1 465 DO jj = 1, jpj 466 DO ji = 1, jpi 467 zt = pts (ji,jj,jk,jp_tem) - 10._wp 468 zs = pts (ji,jj,jk,jp_sal) - 35._wp 469 zh = pdep (ji,jj,jk) 470 ztm = tmask(ji,jj,jk) 471 ! ! potential density referenced at the surface 472 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 473 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 474 & - rn_nu * zt * zs 475 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 476 ! ! density anomaly (masked) 477 zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 478 prd(ji,jj,jk) = zn * r1_rho0 * ztm 479 ! 480 END DO 481 END DO 482 END DO 483 ! 484 CASE( np_leos ) !== linear ISOMIP EOS ==! 485 ! 486 DO jk = 1, jpkm1 487 DO jj = 1, jpj 488 DO ji = 1, jpi 489 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 490 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp 491 zh = pdep (ji,jj,jk) 492 ztm = tmask(ji,jj,jk) 493 ! ! potential density referenced at the surface 494 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 495 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 496 ! ! density anomaly (masked) 497 prd(ji,jj,jk) = zn * r1_rho0 * ztm 498 ! 499 END DO 500 END DO 501 END DO 502 ! 503 END SELECT 504 ! 505 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 506 ! 507 IF( ln_timing ) CALL timing_stop('eos-pot') 508 ! 509 END SUBROUTINE eos_insitu_pot 510 511 512 SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 513 !!---------------------------------------------------------------------- 514 !! *** ROUTINE eos_insitu_2d *** 515 !! 516 !! ** Purpose : Compute the in situ density (ratio rho/rho0) from 517 !! potential temperature and salinity using an equation of state 518 !! selected in the nameos namelist. * 2D field case 519 !! 520 !! ** Action : - prd , the in situ density (no units) (unmasked) 521 !! 522 !!---------------------------------------------------------------------- 523 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 524 ! ! 2 : salinity [psu] 525 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 526 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density 527 ! 528 INTEGER :: ji, jj, jk ! dummy loop indices 529 REAL(wp) :: zt , zh , zs ! local scalars 530 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 531 !!---------------------------------------------------------------------- 532 ! 533 IF( ln_timing ) CALL timing_start('eos2d') 534 ! 535 prd(:,:) = 0._wp 536 ! 537 SELECT CASE( neos ) 538 ! 539 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 540 ! 541 DO jj = 1, jpjm1 542 DO ji = 1, fs_jpim1 ! vector opt. 543 ! 544 zh = pdep(ji,jj) * r1_Z0 ! depth 545 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 546 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 408 DO_3D_11_11( 1, jpkm1 ) 409 ! 410 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 411 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 412 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 413 ztm = tmask(ji,jj,jk) ! tmask 547 414 ! 548 415 zn3 = EOS013*zt & … … 569 436 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 570 437 ! 571 prd(ji,jj) = zn * r1_rho0 - 1._wp ! unmasked in situ density anomaly 572 ! 573 END DO 574 END DO 575 ! 576 CALL lbc_lnk( 'eosbn2', prd, 'T', 1. ) ! Lateral boundary conditions 577 ! 438 prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface 439 ! 440 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 441 END_3D 442 ENDIF 443 578 444 CASE( np_seos ) !== simplified EOS ==! 579 445 ! 580 DO jj = 1, jpjm1 581 DO ji = 1, fs_jpim1 ! vector opt. 582 ! 583 zt = pts (ji,jj,jp_tem) - 10._wp 584 zs = pts (ji,jj,jp_sal) - 35._wp 585 zh = pdep (ji,jj) ! depth at the partial step level 586 ! 587 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 588 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 589 & - rn_nu * zt * zs 590 ! 591 prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 592 ! 593 END DO 594 END DO 595 ! 596 CALL lbc_lnk( 'eosbn2', prd, 'T', 1. ) ! Lateral boundary conditions 446 DO_3D_11_11( 1, jpkm1 ) 447 zt = pts (ji,jj,jk,jp_tem) - 10._wp 448 zs = pts (ji,jj,jk,jp_sal) - 35._wp 449 zh = pdep (ji,jj,jk) 450 ztm = tmask(ji,jj,jk) 451 ! ! potential density referenced at the surface 452 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 453 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 454 & - rn_nu * zt * zs 455 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 456 ! ! density anomaly (masked) 457 zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 458 prd(ji,jj,jk) = zn * r1_rho0 * ztm 459 ! 460 END_3D 461 ! 462 CASE( np_leos ) !== linear ISOMIP EOS ==! 463 ! 464 DO_3D_11_11( 1, jpkm1 ) 465 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 466 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp 467 zh = pdep (ji,jj,jk) 468 ztm = tmask(ji,jj,jk) 469 ! ! potential density referenced at the surface 470 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 471 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 472 ! ! density anomaly (masked) 473 prd(ji,jj,jk) = zn * r1_rho0 * ztm 474 ! 475 END_3D 476 ! 477 END SELECT 478 ! 479 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 480 ! 481 IF( ln_timing ) CALL timing_stop('eos-pot') 482 ! 483 END SUBROUTINE eos_insitu_pot 484 485 486 SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 487 !!---------------------------------------------------------------------- 488 !! *** ROUTINE eos_insitu_2d *** 489 !! 490 !! ** Purpose : Compute the in situ density (ratio rho/rho0) from 491 !! potential temperature and salinity using an equation of state 492 !! selected in the nameos namelist. * 2D field case 493 !! 494 !! ** Action : - prd , the in situ density (no units) (unmasked) 495 !! 496 !!---------------------------------------------------------------------- 497 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 498 ! ! 2 : salinity [psu] 499 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 500 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density 501 ! 502 INTEGER :: ji, jj, jk ! dummy loop indices 503 REAL(wp) :: zt , zh , zs ! local scalars 504 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 505 !!---------------------------------------------------------------------- 506 ! 507 IF( ln_timing ) CALL timing_start('eos2d') 508 ! 509 prd(:,:) = 0._wp 510 ! 511 SELECT CASE( neos ) 512 ! 513 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 514 ! 515 DO_2D_11_11 516 ! 517 zh = pdep(ji,jj) * r1_Z0 ! depth 518 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 519 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 520 ! 521 zn3 = EOS013*zt & 522 & + EOS103*zs+EOS003 523 ! 524 zn2 = (EOS022*zt & 525 & + EOS112*zs+EOS012)*zt & 526 & + (EOS202*zs+EOS102)*zs+EOS002 527 ! 528 zn1 = (((EOS041*zt & 529 & + EOS131*zs+EOS031)*zt & 530 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 531 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 532 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 533 ! 534 zn0 = (((((EOS060*zt & 535 & + EOS150*zs+EOS050)*zt & 536 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 537 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 538 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 539 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 540 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 541 ! 542 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 543 ! 544 prd(ji,jj) = zn * r1_rho0 - 1._wp ! unmasked in situ density anomaly 545 ! 546 END_2D 547 ! 548 CASE( np_seos ) !== simplified EOS ==! 549 ! 550 DO_2D_11_11 551 ! 552 zt = pts (ji,jj,jp_tem) - 10._wp 553 zs = pts (ji,jj,jp_sal) - 35._wp 554 zh = pdep (ji,jj) ! depth at the partial step level 555 ! 556 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 557 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 558 & - rn_nu * zt * zs 559 ! 560 prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 561 ! 562 END_2D 597 563 ! 598 564 CASE( np_leos ) !== ISOMIP EOS ==! 599 565 ! 600 DO jj = 1, jpjm1 601 DO ji = 1, fs_jpim1 ! vector opt. 602 ! 603 zt = pts (ji,jj,jp_tem) - (-1._wp) 604 zs = pts (ji,jj,jp_sal) - 34.2_wp 605 zh = pdep (ji,jj) ! depth at the partial step level 606 ! 607 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 608 ! 609 prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 610 ! 611 END DO 612 END DO 613 ! 614 CALL lbc_lnk( 'eosbn2', prd, 'T', 1. ) ! Lateral boundary conditions 566 DO_2D_11_11 567 ! 568 zt = pts (ji,jj,jp_tem) - (-1._wp) 569 zs = pts (ji,jj,jp_sal) - 34.2_wp 570 zh = pdep (ji,jj) ! depth at the partial step level 571 ! 572 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 573 ! 574 prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 575 ! 576 END_2D 577 ! 615 578 ! 616 579 END SELECT 617 580 ! 618 IF( ln_ctl) CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )581 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 619 582 ! 620 583 IF( ln_timing ) CALL timing_stop('eos2d') … … 648 611 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 649 612 ! 650 DO jk = 1, jpkm1 651 DO jj = 1, jpj 652 DO ji = 1, jpi 653 ! 654 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 655 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 656 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 657 ztm = tmask(ji,jj,jk) ! tmask 658 ! 659 ! alpha 660 zn3 = ALP003 661 ! 662 zn2 = ALP012*zt + ALP102*zs+ALP002 663 ! 664 zn1 = ((ALP031*zt & 665 & + ALP121*zs+ALP021)*zt & 666 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 667 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 668 ! 669 zn0 = ((((ALP050*zt & 670 & + ALP140*zs+ALP040)*zt & 671 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 672 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 673 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 674 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 675 ! 676 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 677 ! 678 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 679 ! 680 ! beta 681 zn3 = BET003 682 ! 683 zn2 = BET012*zt + BET102*zs+BET002 684 ! 685 zn1 = ((BET031*zt & 686 & + BET121*zs+BET021)*zt & 687 & + (BET211*zs+BET111)*zs+BET011)*zt & 688 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 689 ! 690 zn0 = ((((BET050*zt & 691 & + BET140*zs+BET040)*zt & 692 & + (BET230*zs+BET130)*zs+BET030)*zt & 693 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 694 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 695 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 696 ! 697 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 698 ! 699 pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 700 ! 701 END DO 702 END DO 703 END DO 613 DO_3D_11_11( 1, jpkm1 ) 614 ! 615 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 616 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 617 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 618 ztm = tmask(ji,jj,jk) ! tmask 619 ! 620 ! alpha 621 zn3 = ALP003 622 ! 623 zn2 = ALP012*zt + ALP102*zs+ALP002 624 ! 625 zn1 = ((ALP031*zt & 626 & + ALP121*zs+ALP021)*zt & 627 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 628 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 629 ! 630 zn0 = ((((ALP050*zt & 631 & + ALP140*zs+ALP040)*zt & 632 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 633 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 634 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 635 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 636 ! 637 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 638 ! 639 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 640 ! 641 ! beta 642 zn3 = BET003 643 ! 644 zn2 = BET012*zt + BET102*zs+BET002 645 ! 646 zn1 = ((BET031*zt & 647 & + BET121*zs+BET021)*zt & 648 & + (BET211*zs+BET111)*zs+BET011)*zt & 649 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 650 ! 651 zn0 = ((((BET050*zt & 652 & + BET140*zs+BET040)*zt & 653 & + (BET230*zs+BET130)*zs+BET030)*zt & 654 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 655 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 656 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 657 ! 658 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 659 ! 660 pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 661 ! 662 END_3D 704 663 ! 705 664 CASE( np_seos ) !== simplified EOS ==! 706 665 ! 707 DO jk = 1, jpkm1 708 DO jj = 1, jpj 709 DO ji = 1, jpi 710 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 711 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 712 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 713 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 714 ! 715 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 716 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 717 ! 718 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 719 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 720 ! 721 END DO 722 END DO 723 END DO 666 DO_3D_11_11( 1, jpkm1 ) 667 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 668 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 669 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 670 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 671 ! 672 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 673 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 674 ! 675 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 676 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 677 ! 678 END_3D 724 679 ! 725 680 CASE( np_leos ) !== linear ISOMIP EOS ==! 726 681 ! 727 DO jk = 1, jpkm1 728 DO jj = 1, jpj 729 DO ji = 1, jpi 730 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 731 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 732 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 733 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 734 ! 735 zn = rn_a0 * rho0 736 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 737 ! 738 zn = rn_b0 * rho0 739 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 740 ! 741 END DO 742 END DO 743 END DO 682 DO_3D_11_11( 1, jpkm1 ) 683 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 684 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 685 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 686 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 687 ! 688 zn = rn_a0 * rho0 689 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 690 ! 691 zn = rn_b0 * rho0 692 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 693 ! 694 END_3D 744 695 ! 745 696 CASE DEFAULT … … 749 700 END SELECT 750 701 ! 751 IF( ln_ctl) CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', &752 & tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', kdim=jpk )702 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', & 703 & tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', kdim=jpk ) 753 704 ! 754 705 IF( ln_timing ) CALL timing_stop('rab_3d') … … 783 734 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 784 735 ! 785 DO jj = 1, jpjm1 786 DO ji = 1, fs_jpim1 ! vector opt. 787 ! 788 zh = pdep(ji,jj) * r1_Z0 ! depth 789 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 790 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 791 ! 792 ! alpha 793 zn3 = ALP003 794 ! 795 zn2 = ALP012*zt + ALP102*zs+ALP002 796 ! 797 zn1 = ((ALP031*zt & 798 & + ALP121*zs+ALP021)*zt & 799 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 800 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 801 ! 802 zn0 = ((((ALP050*zt & 803 & + ALP140*zs+ALP040)*zt & 804 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 805 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 806 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 807 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 808 ! 809 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 810 ! 811 pab(ji,jj,jp_tem) = zn * r1_rho0 812 ! 813 ! beta 814 zn3 = BET003 815 ! 816 zn2 = BET012*zt + BET102*zs+BET002 817 ! 818 zn1 = ((BET031*zt & 819 & + BET121*zs+BET021)*zt & 820 & + (BET211*zs+BET111)*zs+BET011)*zt & 821 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 822 ! 823 zn0 = ((((BET050*zt & 824 & + BET140*zs+BET040)*zt & 825 & + (BET230*zs+BET130)*zs+BET030)*zt & 826 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 827 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 828 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 829 ! 830 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 831 ! 832 pab(ji,jj,jp_sal) = zn / zs * r1_rho0 833 ! 834 ! 835 END DO 836 END DO 837 ! ! Lateral boundary conditions 838 CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. ) 736 DO_2D_11_11 737 ! 738 zh = pdep(ji,jj) * r1_Z0 ! depth 739 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 740 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 741 ! 742 ! alpha 743 zn3 = ALP003 744 ! 745 zn2 = ALP012*zt + ALP102*zs+ALP002 746 ! 747 zn1 = ((ALP031*zt & 748 & + ALP121*zs+ALP021)*zt & 749 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 750 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 751 ! 752 zn0 = ((((ALP050*zt & 753 & + ALP140*zs+ALP040)*zt & 754 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 755 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 756 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 757 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 758 ! 759 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 760 ! 761 pab(ji,jj,jp_tem) = zn * r1_rho0 762 ! 763 ! beta 764 zn3 = BET003 765 ! 766 zn2 = BET012*zt + BET102*zs+BET002 767 ! 768 zn1 = ((BET031*zt & 769 & + BET121*zs+BET021)*zt & 770 & + (BET211*zs+BET111)*zs+BET011)*zt & 771 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 772 ! 773 zn0 = ((((BET050*zt & 774 & + BET140*zs+BET040)*zt & 775 & + (BET230*zs+BET130)*zs+BET030)*zt & 776 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 777 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 778 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 779 ! 780 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 781 ! 782 pab(ji,jj,jp_sal) = zn / zs * r1_rho0 783 ! 784 ! 785 END_2D 839 786 ! 840 787 CASE( np_seos ) !== simplified EOS ==! 841 788 ! 842 DO jj = 1, jpjm1 843 DO ji = 1, fs_jpim1 ! vector opt. 844 ! 845 zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 846 zs = pts (ji,jj,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 847 zh = pdep (ji,jj) ! depth at the partial step level 848 ! 849 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 850 pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha 851 ! 852 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 853 pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta 854 ! 855 END DO 856 END DO 857 ! ! Lateral boundary conditions 858 CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. ) 789 DO_2D_11_11 790 ! 791 zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 792 zs = pts (ji,jj,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 793 zh = pdep (ji,jj) ! depth at the partial step level 794 ! 795 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 796 pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha 797 ! 798 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 799 pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta 800 ! 801 END_2D 859 802 ! 860 803 CASE( np_leos ) !== linear ISOMIP EOS ==! 861 804 ! 862 DO jj = 1, jpjm1 863 DO ji = 1, fs_jpim1 ! vector opt. 864 ! 865 zt = pts (ji,jj,jp_tem) - (-1._wp) ! pot. temperature anomaly (t-T0) 866 zs = pts (ji,jj,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 867 zh = pdep (ji,jj) ! depth at the partial step level 868 ! 869 zn = rn_a0 * rho0 870 pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha 871 ! 872 zn = rn_b0 * rho0 873 pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta 874 ! 875 END DO 876 END DO 877 ! 878 CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. ) ! Lateral boundary conditions 805 DO_2D_11_11 806 ! 807 zt = pts (ji,jj,jp_tem) - (-1._wp) ! pot. temperature anomaly (t-T0) 808 zs = pts (ji,jj,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 809 zh = pdep (ji,jj) ! depth at the partial step level 810 ! 811 zn = rn_a0 * rho0 812 pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha 813 ! 814 zn = rn_b0 * rho0 815 pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta 816 ! 817 END_2D 879 818 ! 880 819 CASE DEFAULT … … 884 823 END SELECT 885 824 ! 886 IF( ln_ctl) CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', &887 & tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' )825 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', & 826 & tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' ) 888 827 ! 889 828 IF( ln_timing ) CALL timing_stop('rab_2d') … … 1026 965 IF( ln_timing ) CALL timing_start('bn2') 1027 966 ! 1028 DO jk = 2, jpkm1 ! interior points only (2=< jk =< jpkm1 ) 1029 DO jj = 1, jpj ! surface and bottom value set to zero one for all in istate.F90 1030 DO ji = 1, jpi 1031 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 1032 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 1033 ! 1034 zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 1035 zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 1036 ! 1037 pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 1038 & - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) & 1039 & / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 1040 END DO 1041 END DO 1042 END DO 1043 ! 1044 IF(ln_ctl) CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2 : ', kdim=jpk ) 967 DO_3D_11_11( 2, jpkm1 ) 968 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 969 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 970 ! 971 zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 972 zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 973 ! 974 pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 975 & - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) & 976 & / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 977 END_3D 978 ! 979 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2 : ', kdim=jpk ) 1045 980 ! 1046 981 IF( ln_timing ) CALL timing_stop('bn2') … … 1078 1013 z1_T0 = 1._wp/40._wp 1079 1014 ! 1080 DO jj = 1, jpj 1081 DO ji = 1, jpi 1082 ! 1083 zt = ctmp (ji,jj) * z1_T0 1084 zs = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 ) 1085 ztm = tmask(ji,jj,1) 1086 ! 1087 zn = ((((-2.1385727895e-01_wp*zt & 1088 & - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt & 1089 & + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt & 1090 & + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt & 1091 & + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs & 1092 & +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt & 1093 & + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs & 1094 & -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp 1095 ! 1096 zd = (2.0035003456_wp*zt & 1097 & -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt & 1098 & + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp 1099 ! 1100 ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm 1101 ! 1102 END DO 1103 END DO 1015 DO_2D_11_11 1016 ! 1017 zt = ctmp (ji,jj) * z1_T0 1018 zs = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 ) 1019 ztm = tmask(ji,jj,1) 1020 ! 1021 zn = ((((-2.1385727895e-01_wp*zt & 1022 & - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt & 1023 & + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt & 1024 & + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt & 1025 & + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs & 1026 & +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt & 1027 & + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs & 1028 & -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp 1029 ! 1030 zd = (2.0035003456_wp*zt & 1031 & -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt & 1032 & + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp 1033 ! 1034 ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm 1035 ! 1036 END_2D 1104 1037 ! 1105 1038 IF( ln_timing ) CALL timing_stop('eos_pt_from_ct') … … 1133 1066 ! 1134 1067 z1_S0 = 1._wp / 35.16504_wp 1135 DO jj = 1, jpj 1136 DO ji = 1, jpi 1137 zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 ) ! square root salinity 1138 ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 1139 & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 1140 END DO 1141 END DO 1068 DO_2D_11_11 1069 zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 ) ! square root salinity 1070 ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 1071 & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 1072 END_2D 1142 1073 ptf(:,:) = ptf(:,:) * psal(:,:) 1143 1074 ! 1144 1075 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 1145 1076 ! 1146 CASE ( np_eos80 , np_leos) !== PT,SP (UNESCO formulation) ==!1077 CASE ( np_eos80 ) !== PT,SP (UNESCO formulation) ==! 1147 1078 ! 1148 1079 ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) & … … 1190 1121 IF( PRESENT( pdep ) ) ptf = ptf - 7.53e-4 * pdep 1191 1122 ! 1192 CASE ( np_eos80 , np_leos) !== PT,SP (UNESCO formulation) ==!1123 CASE ( np_eos80 ) !== PT,SP (UNESCO formulation) ==! 1193 1124 ! 1194 1125 ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal ) & … … 1242 1173 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 1243 1174 ! 1244 DO jk = 1, jpkm1 1245 DO jj = 1, jpj 1246 DO ji = 1, jpi 1247 ! 1248 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 1249 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 1250 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 1251 ztm = tmask(ji,jj,jk) ! tmask 1252 ! 1253 ! potential energy non-linear anomaly 1254 zn2 = (PEN012)*zt & 1255 & + PEN102*zs+PEN002 1256 ! 1257 zn1 = ((PEN021)*zt & 1258 & + PEN111*zs+PEN011)*zt & 1259 & + (PEN201*zs+PEN101)*zs+PEN001 1260 ! 1261 zn0 = ((((PEN040)*zt & 1262 & + PEN130*zs+PEN030)*zt & 1263 & + (PEN220*zs+PEN120)*zs+PEN020)*zt & 1264 & + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt & 1265 & + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000 1266 ! 1267 zn = ( zn2 * zh + zn1 ) * zh + zn0 1268 ! 1269 ppen(ji,jj,jk) = zn * zh * r1_rho0 * ztm 1270 ! 1271 ! alphaPE non-linear anomaly 1272 zn2 = APE002 1273 ! 1274 zn1 = (APE011)*zt & 1275 & + APE101*zs+APE001 1276 ! 1277 zn0 = (((APE030)*zt & 1278 & + APE120*zs+APE020)*zt & 1279 & + (APE210*zs+APE110)*zs+APE010)*zt & 1280 & + ((APE300*zs+APE200)*zs+APE100)*zs+APE000 1281 ! 1282 zn = ( zn2 * zh + zn1 ) * zh + zn0 1283 ! 1284 pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 1285 ! 1286 ! betaPE non-linear anomaly 1287 zn2 = BPE002 1288 ! 1289 zn1 = (BPE011)*zt & 1290 & + BPE101*zs+BPE001 1291 ! 1292 zn0 = (((BPE030)*zt & 1293 & + BPE120*zs+BPE020)*zt & 1294 & + (BPE210*zs+BPE110)*zs+BPE010)*zt & 1295 & + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000 1296 ! 1297 zn = ( zn2 * zh + zn1 ) * zh + zn0 1298 ! 1299 pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 1300 ! 1301 END DO 1302 END DO 1303 END DO 1175 DO_3D_11_11( 1, jpkm1 ) 1176 ! 1177 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 1178 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 1179 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 1180 ztm = tmask(ji,jj,jk) ! tmask 1181 ! 1182 ! potential energy non-linear anomaly 1183 zn2 = (PEN012)*zt & 1184 & + PEN102*zs+PEN002 1185 ! 1186 zn1 = ((PEN021)*zt & 1187 & + PEN111*zs+PEN011)*zt & 1188 & + (PEN201*zs+PEN101)*zs+PEN001 1189 ! 1190 zn0 = ((((PEN040)*zt & 1191 & + PEN130*zs+PEN030)*zt & 1192 & + (PEN220*zs+PEN120)*zs+PEN020)*zt & 1193 & + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt & 1194 & + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000 1195 ! 1196 zn = ( zn2 * zh + zn1 ) * zh + zn0 1197 ! 1198 ppen(ji,jj,jk) = zn * zh * r1_rho0 * ztm 1199 ! 1200 ! alphaPE non-linear anomaly 1201 zn2 = APE002 1202 ! 1203 zn1 = (APE011)*zt & 1204 & + APE101*zs+APE001 1205 ! 1206 zn0 = (((APE030)*zt & 1207 & + APE120*zs+APE020)*zt & 1208 & + (APE210*zs+APE110)*zs+APE010)*zt & 1209 & + ((APE300*zs+APE200)*zs+APE100)*zs+APE000 1210 ! 1211 zn = ( zn2 * zh + zn1 ) * zh + zn0 1212 ! 1213 pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 1214 ! 1215 ! betaPE non-linear anomaly 1216 zn2 = BPE002 1217 ! 1218 zn1 = (BPE011)*zt & 1219 & + BPE101*zs+BPE001 1220 ! 1221 zn0 = (((BPE030)*zt & 1222 & + BPE120*zs+BPE020)*zt & 1223 & + (BPE210*zs+BPE110)*zs+BPE010)*zt & 1224 & + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000 1225 ! 1226 zn = ( zn2 * zh + zn1 ) * zh + zn0 1227 ! 1228 pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 1229 ! 1230 END_3D 1304 1231 ! 1305 1232 CASE( np_seos ) !== Vallis (2006) simplified EOS ==! 1306 1233 ! 1307 DO jk = 1, jpkm1 1308 DO jj = 1, jpj 1309 DO ji = 1, jpi 1310 zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0) 1311 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 1312 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 1313 ztm = tmask(ji,jj,jk) ! tmask 1314 zn = 0.5_wp * zh * r1_rho0 * ztm 1315 ! ! Potential Energy 1316 ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 1317 ! ! alphaPE 1318 pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 1319 pab_pe(ji,jj,jk,jp_sal) = rn_b0 * rn_mu2 * zn 1320 ! 1321 END DO 1322 END DO 1323 END DO 1234 DO_3D_11_11( 1, jpkm1 ) 1235 zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0) 1236 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 1237 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 1238 ztm = tmask(ji,jj,jk) ! tmask 1239 zn = 0.5_wp * zh * r1_rho0 * ztm 1240 ! ! Potential Energy 1241 ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 1242 ! ! alphaPE 1243 pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 1244 pab_pe(ji,jj,jk,jp_sal) = rn_b0 * rn_mu2 * zn 1245 ! 1246 END_3D 1324 1247 ! 1325 1248 CASE( np_leos ) !== linear ISOMIP EOS ==! 1326 1249 ! 1327 DO jk = 1, jpkm1 1328 DO jj = 1, jpj 1329 DO ji = 1, jpi 1330 zt = pts(ji,jj,jk,jp_tem) - (-1._wp) ! temperature anomaly (t-T0) 1331 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 1332 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 1333 ztm = tmask(ji,jj,jk) ! tmask 1334 zn = 0.5_wp * zh * r1_rho0 * ztm 1335 ! ! Potential Energy 1336 ppen(ji,jj,jk) = 0. 1337 ! ! alphaPE 1338 pab_pe(ji,jj,jk,jp_tem) = 0. 1339 pab_pe(ji,jj,jk,jp_sal) = 0. 1340 ! 1341 END DO 1342 END DO 1343 END DO 1250 DO_3D_11_11( 1, jpkm1 ) 1251 zt = pts(ji,jj,jk,jp_tem) - (-1._wp) ! temperature anomaly (t-T0) 1252 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 1253 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 1254 ztm = tmask(ji,jj,jk) ! tmask 1255 zn = 0.5_wp * zh * r1_rho0 * ztm 1256 ! ! Potential Energy 1257 ppen(ji,jj,jk) = 0. 1258 ! ! alphaPE 1259 pab_pe(ji,jj,jk,jp_tem) = 0. 1260 pab_pe(ji,jj,jk,jp_sal) = 0. 1261 ! 1262 END_3D 1344 1263 ! 1345 1264 CASE DEFAULT … … 1365 1284 INTEGER :: ioptio ! local integer 1366 1285 !! 1367 NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS , ln_LEOS, & 1368 & rn_a0 , rn_b0 , rn_lambda1, rn_mu1 , & 1369 & rn_lambda2, rn_mu2 , rn_nu 1370 !!---------------------------------------------------------------------- 1371 ! 1372 REWIND( numnam_ref ) ! Namelist nameos in reference namelist : equation of state 1286 NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS, ln_LEOS, rn_a0, rn_b0, & 1287 & rn_lambda1, rn_mu1, rn_lambda2, rn_mu2, rn_nu 1288 !!---------------------------------------------------------------------- 1289 ! 1373 1290 READ ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 ) 1374 1291 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist' ) 1375 1292 ! 1376 REWIND( numnam_cfg ) ! Namelist nameos in configuration namelist : equation of state1377 1293 READ ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 ) 1378 1294 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist' ) -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/MY_SRC/isfcavgam.F90
r12077 r13159 91 91 pgs(:,:) = rn_gammas0 92 92 CASE ( 'vel' ) ! gamma is proportional to u* 93 CALL gammats_vel ( zutbl, zvtbl, rCd0_top, r _ke0_top, pgt, pgs )93 CALL gammats_vel ( zutbl, zvtbl, rCd0_top, rn_vtide**2, pgt, pgs ) 94 94 CASE ( 'vel_stab' ) ! gamma depends of stability of boundary layer and u* 95 CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r _ke0_top, pqoce, pqfwf, pgt, pgs )95 CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, rn_vtide**2, pqoce, pqfwf, pgt, pgs ) 96 96 CASE DEFAULT 97 97 CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)') -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/MY_SRC/isfstp.F90
r12077 r13159 250 250 IF ( l_isfoasis .AND. ln_isf ) THEN 251 251 ! 252 CALL ctl_stop( ' ln_ctl and ice shelf not tested' )252 CALL ctl_stop( 'namelist combination ln_cpl and ln_isf not tested' ) 253 253 ! 254 254 ! NEMO coupled to ATMO model with isf cavity need oasis method for melt computation … … 291 291 !!---------------------------------------------------------------------- 292 292 ! 293 REWIND( numnam_ref ) ! Namelist namsbc_rnf in reference namelist : Runoffs294 293 READ ( numnam_ref, namisf, IOSTAT = ios, ERR = 901) 295 294 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namisf in reference namelist' ) 296 295 ! 297 REWIND( numnam_cfg ) ! Namelist namsbc_rnf in configuration namelist : Runoffs298 296 READ ( numnam_cfg, namisf, IOSTAT = ios, ERR = 902 ) 299 297 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namisf in configuration namelist' ) -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/MY_SRC/istate.F90
r12353 r13159 41 41 PUBLIC istate_init ! routine called by step.F90 42 42 43 !! * Substitutions 44 # include "do_loop_substitute.h90" 43 45 !!---------------------------------------------------------------------- 44 46 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 75 77 rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk 76 78 rn2b (:,:,: ) = 0._wp ; rn2 (:,:,: ) = 0._wp ! set one for all to 0 at levels 1 and jpk 77 ts (:,:,:,:,Kaa) = 0._wp! set one for all to 0 at level jpk79 ts (:,:,:,:,Kaa) = 0._wp ! set one for all to 0 at level jpk 78 80 rab_b(:,:,:,:) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk 79 81 #if defined key_agrif … … 90 92 ! ! --------------- 91 93 numror = 0 ! define numror = 0 -> no restart file to read 92 neuler = 0! Set time-step indicator at nit000 (euler forward)94 l_1st_euler = .true. ! Set time-step indicator at nit000 (euler forward) 93 95 CALL day_init ! model calendar (using both namelist and restart infos) 94 96 ! ! Initialization of ocean to zero … … 103 105 ! Apply minimum wetdepth criterion 104 106 ! 105 DO jj = 1,jpj 106 DO ji = 1,jpi 107 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN 108 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 109 ENDIF 110 END DO 111 END DO 107 DO_2D_11_11 108 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN 109 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 110 ENDIF 111 END_2D 112 112 ENDIF 113 113 uu (:,:,:,Kbb) = 0._wp … … 159 159 ! 160 160 !!gm the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 161 DO jk = 1, jpkm1 162 DO jj = 1, jpj 163 DO ji = 1, jpi 164 uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 165 vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 166 ! 167 uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 168 vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 169 END DO 170 END DO 171 END DO 161 DO_3D_11_11( 1, jpkm1 ) 162 uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 163 vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 164 ! 165 uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 166 vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 167 END_3D 172 168 ! 173 169 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/MY_SRC/sbcfwb.F90
r12489 r13159 151 151 ENDIF 152 152 ! ! Update fwfold if new year start 153 ikty = 365 * 86400 / rn_Dt !!bug use of 365 days leap year or 360d year !!!!!!!153 ikty = 365 * 86400 / rn_Dt !!bug use of 365 days leap year or 360d year !!!!!!! 154 154 IF( MOD( kt, ikty ) == 0 ) THEN 155 155 a_fwb_b = a_fwb ! mean sea level taking into account the ice+snow -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/ISOMIP+/MY_SRC/tradmp.F90
r12353 r13159 51 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: resto !: restoring coeff. on T and S (s-1) 52 52 53 !! * Substitutions 54 # include "do_loop_substitute.h90" 53 55 !!---------------------------------------------------------------------- 54 56 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 110 112 CASE( 0 ) !* newtonian damping throughout the water column *! 111 113 DO jn = 1, jpts 112 DO jk = 1, jpkm1 113 DO jj = 2, jpjm1 114 DO ji = fs_2, fs_jpim1 ! vector opt. 115 pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs) & 116 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) ) 117 END DO 118 END DO 119 END DO 114 DO_3D_00_00( 1, jpkm1 ) 115 pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs) & 116 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) ) 117 END_3D 120 118 END DO 121 119 ! 122 120 CASE ( 1 ) !* no damping in the turbocline (avt > 5 cm2/s) *! 123 DO jk = 1, jpkm1 124 DO jj = 2, jpjm1 125 DO ji = fs_2, fs_jpim1 ! vector opt. 126 IF( avt(ji,jj,jk) <= avt_c ) THEN 127 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 128 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 129 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 130 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 131 ENDIF 132 END DO 133 END DO 134 END DO 121 DO_3D_00_00( 1, jpkm1 ) 122 IF( avt(ji,jj,jk) <= avt_c ) THEN 123 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 124 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 125 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 126 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 127 ENDIF 128 END_3D 135 129 ! 136 130 CASE ( 2 ) !* no damping in the mixed layer *! 137 DO jk = 1, jpkm1 138 DO jj = 2, jpjm1 139 DO ji = fs_2, fs_jpim1 ! vector opt. 140 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 141 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 142 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 143 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 144 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 145 ENDIF 146 END DO 147 END DO 148 END DO 131 DO_3D_00_00( 1, jpkm1 ) 132 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 133 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 134 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 135 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 136 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 137 ENDIF 138 END_3D 149 139 ! 150 140 END SELECT … … 157 147 ENDIF 158 148 ! ! Control print 159 IF( ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp - Ta: ', mask1=tmask, &160 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )149 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp - Ta: ', mask1=tmask, & 150 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 161 151 ! 162 152 IF( ln_timing ) CALL timing_stop('tra_dmp') … … 178 168 !!---------------------------------------------------------------------- 179 169 ! 180 REWIND( numnam_ref ) ! Namelist namtra_dmp in reference namelist : T & S relaxation181 170 READ ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901) 182 171 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist' ) 183 172 ! 184 REWIND( numnam_cfg ) ! Namelist namtra_dmp in configuration namelist : T & S relaxation185 173 READ ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 ) 186 174 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist' ) -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/file_def_nemo-oce.xml
r11930 r13159 28 28 <field field_ref="empmr" name="empmr" /> 29 29 <!-- --> 30 <field field_ref="taum" name="taum" /> 31 <field field_ref="wspd" name="windsp" /> 30 <field field_ref="taum" name="taum" /> 31 <field field_ref="wspd" name="windsp" /> 32 <!-- --> 33 <field field_ref="Cd_oce" name="Cd_oce" /> 34 <field field_ref="Ce_oce" name="Ce_oce" /> 35 <field field_ref="Ch_oce" name="Ch_oce" /> 36 <field field_ref="theta_zt" name="theta_zt" /> 37 <field field_ref="q_zt" name="q_zt" /> 38 <field field_ref="theta_zu" name="theta_zu" /> 39 <field field_ref="q_zu" name="q_zu" /> 40 <field field_ref="ssq" name="ssq" /> 41 <field field_ref="wspd_blk" name="wspd_blk" /> 32 42 </file> 33 43 -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/launch_sasf.sh
r11996 r13159 1 1 #!/bin/bash 2 2 3 # NEMO directory where to fetch compiled STATION_ASF nemo.exe + setup: 4 NEMO_DIR="${HOME}/NEMO/NEMOvdev_r11085_ASINTER-05_Brodeau_Advanced_Bulk" 3 ################################################################ 4 # 5 # Script to launch a set of STATION_ASF simulations 6 # 7 # L. Brodeau, 2020 8 # 9 ################################################################ 10 11 # What directory inside "tests" actually contains the compiled "nemo.exe" for STATION_ASF ? 12 TC_DIR="STATION_ASF2" 13 14 # DATA_IN_DIR => Directory containing sea-surface + atmospheric forcings 15 # (get it there https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/): 16 if [ `hostname` = "merlat" ]; then 17 DATA_IN_DIR="/MEDIA/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 18 elif [ `hostname` = "luitel" ]; then 19 DATA_IN_DIR="/data/gcm_setup/STATION_ASF/input_data_STATION_ASF_2016-2018" 20 elif [ `hostname` = "ige-meom-cal1" ]; then 21 DATA_IN_DIR="/mnt/meom/workdir/brodeau/STATION_ASF/input_data_STATION_ASF_2016-2018" 22 elif [ `hostname` = "salvelinus" ]; then 23 DATA_IN_DIR="/opt/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 24 else 25 echo "Oops! We don't know `hostname` yet! Define 'DATA_IN_DIR' in the script!"; exit 26 fi 27 28 expdir=`basename ${PWD}`; # we expect "EXPREF" or "EXP00" normally... 29 30 # NEMOGCM root directory where to fetch compiled STATION_ASF nemo.exe + setup: 31 NEMO_WRK_DIR=`pwd | sed -e "s|/tests/STATION_ASF/${expdir}||g"` 5 32 6 33 # Directory where to run the simulation: 7 WORK_DIR="${HOME}/tmp/STATION_ASF"34 PROD_DIR="${HOME}/tmp/STATION_ASF" 8 35 9 36 10 # FORC_DIR => Directory containing sea-surface + atmospheric forcings 11 # (get it there https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/): 12 if [ `hostname` = "merlat" ]; then 13 FORC_DIR="/MEDIA/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 14 elif [ `hostname` = "luitel" ]; then 15 FORC_DIR="/data/gcm_setup/STATION_ASF/input_data_STATION_ASF_2016-2018" 16 elif [ `hostname` = "ige-meom-cal1" ]; then 17 FORC_DIR="/mnt/meom/workdir/brodeau/STATION_ASF/input_data_STATION_ASF_2016-2018" 18 elif [ `hostname` = "salvelinus" ]; then 19 FORC_DIR="/opt/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 20 else 21 echo "Boo!"; exit 22 fi 23 #====================== 24 mkdir -p ${WORK_DIR} 37 ####### End of normal user configurable section ####### 25 38 26 NEMO_EXE="${NEMO_DIR}/tests/STATION_ASF/BLD/bin/nemo.exe" 27 if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled nemo.exe found into ${NEMO_DIR}/tests/STATION_ASF/BLD/bin !"; exit; fi 39 #================================================================================ 28 40 29 NEMO_EXPREF="${NEMO_DIR}/tests/STATION_ASF/EXPREF" 41 # NEMO executable to use is: 42 NEMO_EXE="${NEMO_WRK_DIR}/tests/${TC_DIR}/BLD/bin/nemo.exe" 43 44 45 echo "###########################################################" 46 echo "# S T A T I O N A i r - S e a F l u x #" 47 echo "###########################################################" 48 echo 49 echo " We shall work in here: ${STATION_ASF_DIR}/" 50 echo " NEMOGCM work depository is: ${NEMO_WRK_DIR}/" 51 echo " ==> NEMO EXE to use: ${NEMO_EXE}" 52 echo " Input forcing data into: ${DATA_IN_DIR}/" 53 echo " Production will be done into: ${PROD_DIR}/" 54 echo 55 56 mkdir -p ${PROD_DIR} 57 58 if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled 'nemo.exe' found into `dirname ${NEMO_EXE}` !"; exit; fi 59 60 echo 61 echo " *** Using the following NEMO executable:" 62 echo " ${NEMO_EXE} " 63 echo 64 65 NEMO_EXPREF="${NEMO_WRK_DIR}/tests/STATION_ASF/EXPREF" 30 66 if [ ! -d ${NEMO_EXPREF} ]; then echo " Mhhh, no EXPREF directory ${NEMO_EXPREF} !"; exit; fi 31 67 32 rsync -avP ${NEMO_EXE} ${ WORK_DIR}/68 rsync -avP ${NEMO_EXE} ${PROD_DIR}/ 33 69 34 70 for ff in "context_nemo.xml" "domain_def_nemo.xml" "field_def_nemo-oce.xml" "file_def_nemo-oce.xml" "grid_def_nemo.xml" "iodef.xml" "namelist_ref"; do 35 71 if [ ! -f ${NEMO_EXPREF}/${ff} ]; then echo " Mhhh, ${ff} not found into ${NEMO_EXPREF} !"; exit; fi 36 rsync -avPL ${NEMO_EXPREF}/${ff} ${ WORK_DIR}/72 rsync -avPL ${NEMO_EXPREF}/${ff} ${PROD_DIR}/ 37 73 done 38 74 39 75 # Copy forcing to work directory: 40 rsync -avP ${ FORC_DIR}/Station_PAPA_50N-145W*.nc ${WORK_DIR}/76 rsync -avP ${DATA_IN_DIR}/Station_PAPA_50N-145W*.nc ${PROD_DIR}/ 41 77 42 for CASE in "ECMWF -noskin" "COARE3p6-noskin" "ECMWF" "COARE3p6" "NCAR"; do78 for CASE in "ECMWF" "COARE3p6" "NCAR" "ECMWF-noskin" "COARE3p6-noskin"; do 43 79 44 80 echo ; echo … … 50 86 scase=`echo "${CASE}" | tr '[:upper:]' '[:lower:]'` 51 87 52 rm -f ${ WORK_DIR}/namelist_cfg53 rsync -avPL ${NEMO_EXPREF}/namelist_${scase}_cfg ${ WORK_DIR}/namelist_cfg88 rm -f ${PROD_DIR}/namelist_cfg 89 rsync -avPL ${NEMO_EXPREF}/namelist_${scase}_cfg ${PROD_DIR}/namelist_cfg 54 90 55 cd ${ WORK_DIR}/91 cd ${PROD_DIR}/ 56 92 echo 57 93 echo "Launching NEMO !" 58 ./nemo.exe 1> 94 ./nemo.exe 1>out_nemo.out 2>err_nemo.err 59 95 echo "Done!" 60 96 echo -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_coare3p6-noskin_cfg
r12489 r13159 29 29 cn_exp = 'STATION_ASF-COARE3p6-noskin' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 35 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 36 38 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_coare3p6_cfg
r12489 r13159 29 29 cn_exp = 'STATION_ASF-COARE3p6' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 35 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 36 38 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard … … 134 140 ln_humi_rlh = .true. ! humidity specified below in "sn_humi" is relative humidity [%] if .true. 135 141 ! 136 cn_dir = './'! root directory for the bulk data location142 cn_dir = './' ! root directory for the bulk data location 137 143 !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 138 144 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 163 169 ln_read_frq = .false. ! specify whether we must read frq or not 164 170 165 cn_dir = './' 171 cn_dir = './' ! root directory for the ocean data location 166 172 !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 167 173 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 215 221 &nameos ! ocean Equation Of Seawater (default: NO selection) 216 222 !----------------------------------------------------------------------- 217 ln_eos80 = .true. ! = Use EOS80223 ln_eos80 = .true. ! = Use EOS80 218 224 / 219 225 !!====================================================================== -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ecmwf-noskin_cfg
r12489 r13159 29 29 cn_exp = 'STATION_ASF-ECMWF-noskin' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 35 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 36 38 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ecmwf_cfg
r12489 r13159 29 29 cn_exp = 'STATION_ASF-ECMWF' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 35 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 36 38 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard … … 134 140 ln_humi_rlh = .true. ! humidity specified below in "sn_humi" is relative humidity [%] if .true. 135 141 ! 136 cn_dir = './'! root directory for the bulk data location142 cn_dir = './' ! root directory for the bulk data location 137 143 !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 138 144 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 163 169 ln_read_frq = .false. ! specify whether we must read frq or not 164 170 165 cn_dir = './' 171 cn_dir = './' ! root directory for the ocean data location 166 172 !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 167 173 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 215 221 &nameos ! ocean Equation Of Seawater (default: NO selection) 216 222 !----------------------------------------------------------------------- 217 ln_eos80 = .true. ! = Use EOS80223 ln_eos80 = .true. ! = Use EOS80 218 224 / 219 225 !!====================================================================== -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/EXPREF/namelist_ncar_cfg
r12489 r13159 29 29 cn_exp = 'STATION_ASF-NCAR' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 35 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 36 38 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard … … 134 140 ln_humi_rlh = .true. ! humidity specified below in "sn_humi" is relative humidity [%] if .true. 135 141 ! 136 cn_dir = './'! root directory for the bulk data location142 cn_dir = './' ! root directory for the bulk data location 137 143 !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 138 144 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 163 169 ln_read_frq = .false. ! specify whether we must read frq or not 164 170 165 cn_dir = './' 171 cn_dir = './' ! root directory for the ocean data location 166 172 !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 167 173 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 215 221 &nameos ! ocean Equation Of Seawater (default: NO selection) 216 222 !----------------------------------------------------------------------- 217 ln_eos80 = .true. ! = Use EOS80223 ln_eos80 = .true. ! = Use EOS80 218 224 / 219 225 !!====================================================================== -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/nemogcm.F90
r12254 r13159 98 98 IF( nstop /= 0 .AND. lwp ) THEN ! error print 99 99 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 100 CALL ctl_stop( ctmp1 ) 100 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 101 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 101 102 ENDIF 102 103 ! … … 177 178 ! 178 179 ! finalize the definition of namctl variables 179 IF( sn_cfctl%l_allon ) THEN 180 ! Turn on all options. 181 CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 182 ! Ensure all processors are active 183 sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 184 ELSEIF( sn_cfctl%l_config ) THEN 185 ! Activate finer control of report outputs 186 ! optionally switch off output from selected areas (note this only 187 ! applies to output which does not involve global communications) 188 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 189 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 190 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 191 ELSE 192 ! turn off all options. 193 CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 194 ENDIF 180 IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) & 181 & CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 195 182 ! 196 183 lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print … … 311 298 WRITE(numout,*) '~~~~~~~~' 312 299 WRITE(numout,*) ' Namelist namctl' 313 WRITE(numout,*) ' sn_cfctl%l_glochk = ', sn_cfctl%l_glochk314 WRITE(numout,*) ' sn_cfctl%l_allon = ', sn_cfctl%l_allon315 WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config316 300 WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 317 301 WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat … … 449 433 450 434 451 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto , for_all)435 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 452 436 !!---------------------------------------------------------------------- 453 437 !! *** ROUTINE nemo_set_cfctl *** 454 438 !! 455 439 !! ** Purpose : Set elements of the output control structure to setto. 456 !! for_all should be .false. unless all areas are to be457 !! treated identically.458 440 !! 459 441 !! ** Method : Note this routine can be used to switch on/off some 460 !! types of output for selected areas but any output types 461 !! that involve global communications (e.g. mpp_max, glob_sum) 462 !! should be protected from selective switching by the 463 !! for_all argument 464 !!---------------------------------------------------------------------- 465 LOGICAL :: setto, for_all 466 TYPE(sn_ctl) :: sn_cfctl 467 !!---------------------------------------------------------------------- 468 IF( for_all ) THEN 469 sn_cfctl%l_runstat = setto 470 sn_cfctl%l_trcstat = setto 471 ENDIF 442 !! types of output for selected areas. 443 !!---------------------------------------------------------------------- 444 TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 445 LOGICAL , INTENT(in ) :: setto 446 !!---------------------------------------------------------------------- 447 sn_cfctl%l_runstat = setto 448 sn_cfctl%l_trcstat = setto 472 449 sn_cfctl%l_oceout = setto 473 450 sn_cfctl%l_layout = setto -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/MY_SRC/stpctl.F90
r12254 r13159 19 19 USE dom_oce ! ocean space and time domain variables 20 20 USE sbc_oce ! surface fluxes and stuff 21 ! 21 22 USE diawri ! Standard run outputs (dia_wri_state routine) 22 !23 23 USE in_out_manager ! I/O manager 24 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 25 USE lib_mpp ! distributed memory computing 26 26 ! 27 27 USE netcdf ! NetCDF library 28 28 IMPLICIT NONE … … 31 31 PUBLIC stp_ctl ! routine called by step.F90 32 32 33 INTEGER :: idrun, idtime, idtau, idqns, idemp, istatus34 LOGICAL :: lsomeoce33 INTEGER :: nrunid ! netcdf file id 34 INTEGER, DIMENSION(3) :: nvarid ! netcdf variable id 35 35 !!---------------------------------------------------------------------- 36 36 !! NEMO/SAS 4.0 , NEMO Consortium (2018) … … 40 40 CONTAINS 41 41 42 SUBROUTINE stp_ctl( kt, K bb, Kmm, kindic)42 SUBROUTINE stp_ctl( kt, Kmm ) 43 43 !!---------------------------------------------------------------------- 44 44 !! *** ROUTINE stp_ctl *** 45 !! 45 !! 46 46 !! ** Purpose : Control the run 47 47 !! 48 48 !! ** Method : - Save the time step in numstp 49 49 !! - Print it each 50 time steps 50 !! - Stop the run IF problem encountered by setting indic=-3 50 !! - Stop the run IF problem encountered by setting nstop > 0 51 !! Problems checked: wind stress module max larger than 5 N/m^2 52 !! non-solar heat flux max larger than 2000 W/m^2 53 !! Evaporation-Precip max larger than 1.E-3 kg/m^2/s 51 54 !! 52 55 !! ** Actions : "time.step" file = last ocean time-step 53 56 !! "run.stat" file = run statistics 54 !! nstop indicator sheared among all local domain (lk_mpp=T)57 !! nstop indicator sheared among all local domain 55 58 !!---------------------------------------------------------------------- 56 59 INTEGER, INTENT(in ) :: kt ! ocean time-step index 57 INTEGER, INTENT(in ) :: Kbb, Kmm ! ocean time level index 58 INTEGER, INTENT(inout) :: kindic ! error indicator 59 !! 60 REAL(wp), DIMENSION(3) :: zmax 61 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 62 CHARACTER(len=20) :: clname 63 !!---------------------------------------------------------------------- 64 ! 65 ll_wrtstp = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 66 ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 67 ll_wrtruns = ll_colruns .AND. lwm 68 IF( kt == nit000 .AND. lwp ) THEN 69 WRITE(numout,*) 70 WRITE(numout,*) 'stp_ctl : time-stepping control' 71 WRITE(numout,*) '~~~~~~~' 72 ! ! open time.step file 73 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 74 ! ! open run.stat file(s) at start whatever 75 ! ! the value of sn_cfctl%ptimincr 76 IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 60 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 61 !! 62 INTEGER :: ji ! dummy loop indices 63 INTEGER :: idtime, istatus 64 INTEGER , DIMENSION(4) :: iareasum, iareamin, iareamax 65 INTEGER , DIMENSION(3,3) :: iloc ! min/max loc indices 66 REAL(wp) :: zzz ! local real 67 REAL(wp), DIMENSION(4) :: zmax, zmaxlocal 68 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 69 LOGICAL, DIMENSION(jpi,jpj) :: llmsk 70 CHARACTER(len=20) :: clname 71 !!---------------------------------------------------------------------- 72 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 73 ! 74 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 75 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 76 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 77 ! 78 IF( kt == nit000 ) THEN 79 ! 80 IF( lwp ) THEN 81 WRITE(numout,*) 82 WRITE(numout,*) 'stp_ctl : time-stepping control' 83 WRITE(numout,*) '~~~~~~~' 84 ENDIF 85 ! ! open time.step ascii file, done only by 1st subdomain 86 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 87 ! 88 IF( ll_wrtruns ) THEN 89 ! ! open run.stat ascii file, done only by 1st subdomain 77 90 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 91 ! ! open run.stat.nc netcdf file, done only by 1st subdomain 78 92 clname = 'run.stat.nc' 79 93 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 80 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 81 istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 82 istatus = NF90_DEF_VAR( idrun, 'tau_max', NF90_DOUBLE, (/ idtime /), idtau ) 83 istatus = NF90_DEF_VAR( idrun, 'qns_max', NF90_DOUBLE, (/ idtime /), idqns ) 84 istatus = NF90_DEF_VAR( idrun, 'emp_max', NF90_DOUBLE, (/ idtime /), idemp ) 85 istatus = NF90_ENDDEF(idrun) 86 ENDIF 87 ENDIF 88 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 89 ! 90 IF(lwm .AND. ll_wrtstp) THEN !== current time step ==! ("time.step" file) 94 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 95 istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 96 istatus = NF90_DEF_VAR( nrunid, 'tau_max', NF90_DOUBLE, (/ idtime /), nvarid(1) ) 97 istatus = NF90_DEF_VAR( nrunid, 'qns_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 98 istatus = NF90_DEF_VAR( nrunid, 'emp_max', NF90_DOUBLE, (/ idtime /), nvarid(3) ) 99 istatus = NF90_ENDDEF(nrunid) 100 ENDIF 101 ! 102 ENDIF 103 ! 104 ! !== write current time step ==! 105 ! !== done only by 1st subdomain at writting timestep ==! 106 IF( lwm .AND. ll_wrtstp ) THEN 91 107 WRITE ( numstp, '(1x, i8)' ) kt 92 108 REWIND( numstp ) 93 109 ENDIF 94 ! 95 ! !== test of extrema ==! 96 zmax(1) = MAXVAL( taum(:,:) , mask = tmask(:,:,1) == 1._wp ) ! max wind stress module 97 zmax(2) = MAXVAL( ABS( qns(:,:) ) , mask = tmask(:,:,1) == 1._wp ) ! max non-solar heat flux 98 zmax(3) = MAXVAL( ABS( emp(:,:) ) , mask = tmask(:,:,1) == 1._wp ) ! max E-P 99 ! 110 ! !== test of local extrema ==! 111 ! !== done by all processes at every time step ==! 112 llmsk(:,:) = tmask(:,:,1) == 1._wp 113 IF( COUNT( llmsk(:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 114 zmax(1) = MAXVAL( taum(:,:) , mask = llmsk ) ! max wind stress module 115 zmax(2) = MAXVAL( ABS( qns(:,:) ) , mask = llmsk ) ! max non-solar heat flux 116 zmax(3) = MAXVAL( ABS( emp(:,:) ) , mask = llmsk ) ! max E-P 117 ELSE 118 IF( ll_colruns ) THEN ! default value: must not be kept when calling mpp_max -> must be as small as possible 119 zmax(1:3) = -HUGE(1._wp) 120 ELSE ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 121 zmax(1:3) = 0._wp 122 ENDIF 123 ENDIF 124 zmax(4) = REAL( nstop, wp ) ! stop indicator 125 ! !== get global extrema ==! 126 ! !== done by all processes if writting run.stat ==! 100 127 IF( ll_colruns ) THEN 128 zmaxlocal(:) = zmax(:) 101 129 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 102 nstop = NINT( zmax(3) ) ! nstop indicator sheared among all local domains 103 ENDIF 104 ! !== run statistics ==! ("run.stat" files) 130 nstop = NINT( zmax(4) ) ! update nstop indicator (now sheared among all local domains) 131 ENDIF 132 ! !== write "run.stat" files ==! 133 ! !== done only by 1st subdomain at writting timestep ==! 105 134 IF( ll_wrtruns ) THEN 106 135 WRITE(numrun,9500) kt, zmax(1), zmax(2), zmax(3) 107 istatus = NF90_PUT_VAR( idrun, idtau, (/ zmax(1)/), (/kt/), (/1/) ) 108 istatus = NF90_PUT_VAR( idrun, idqns, (/ zmax(2)/), (/kt/), (/1/) ) 109 istatus = NF90_PUT_VAR( idrun, idemp, (/ zmax(3)/), (/kt/), (/1/) ) 110 IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 111 IF( kt == nitend ) istatus = NF90_CLOSE(idrun) 136 istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 137 istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 138 istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/ zmax(3)/), (/kt/), (/1/) ) 139 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 112 140 END IF 113 ! !== error handling ==! 114 IF( ( sn_cfctl%l_glochk .OR. lsomeoce ) .AND. ( & ! domain contains some ocean points, check for sensible ranges 115 & zmax(1) > 5._wp .OR. & ! too large wind stress ( > 5 N/m^2 ) 116 & zmax(2) > 2000._wp .OR. & ! too large non-solar heat flux ( > 2000 W/m^2) 117 & zmax(3) > 1.E-3_wp .OR. & ! too large net freshwater flux ( kg/m^2/s) 118 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN ! NaN encounter in the tests 119 120 !! We are 1D so no need to find a spatial location of the rogue point. 121 141 ! !== error handling ==! 142 ! !== done by all processes at every time step ==! 143 ! 144 IF( zmax(1) > 5._wp .OR. & ! too large wind stress ( > 5 N/m^2 ) 145 & zmax(2) > 2000._wp .OR. & ! too large non-solar heat flux ( > 2000 W/m^2 ) 146 & zmax(3) > 1.E-3_wp .OR. & ! too large net freshwater flux ( > 1.E-3 kg/m^2/s ) 147 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests 148 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 149 ! 150 iloc(:,:) = 0 151 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 152 ! first: close the netcdf file, so we can read it 153 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid) 154 ! get global loc on the min/max 155 CALL mpp_maxloc( 'stpctl', taum(:,:) , tmask(:,:,1), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 156 CALL mpp_maxloc( 'stpctl',ABS( qns(:,:) ), tmask(:,:,1), zzz, iloc(1:2,2) ) 157 CALL mpp_minloc( 'stpctl',ABS( emp(:,:) ), tmask(:,:,1), zzz, iloc(1:2,3) ) 158 ! find which subdomain has the max. 159 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 160 DO ji = 1, 4 161 IF( zmaxlocal(ji) == zmax(ji) ) THEN 162 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 163 ENDIF 164 END DO 165 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain 166 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain 167 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain 168 ELSE ! find local min and max locations: 169 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 170 iloc(1:2,1) = MAXLOC( taum(:,:) , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 171 iloc(1:2,2) = MAXLOC( ABS( qns(:,:) ), mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 172 iloc(1:2,3) = MINLOC( ABS( emp(:,:) ), mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 173 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 174 ENDIF 175 ! 122 176 WRITE(ctmp1,*) ' stp_ctl: |tau_mod| > 5 N/m2 or |qns| > 2000 W/m2 or |emp| > 1.E-3 or NaN encounter in the tests' 123 WRITE(ctmp2,9500) kt, zmax(1), zmax(2), zmax(3) 124 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort.nc file' 125 177 CALL wrt_line( ctmp2, kt, '|tau| max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 178 CALL wrt_line( ctmp3, kt, '|qns| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 179 CALL wrt_line( ctmp4, kt, 'emp max', zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 180 IF( Agrif_Root() ) THEN 181 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' 182 ELSE 183 WRITE(ctmp6,*) ' ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 184 ENDIF 185 ! 126 186 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 127 128 IF( .NOT. sn_cfctl%l_glochk ) THEN 129 WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea 130 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ' ', ctmp6, ' ' ) 131 ELSE 132 CALL ctl_stop( ctmp1, ' ', ctmp2, ' ', ctmp6, ' ' ) 133 ENDIF 134 135 kindic = -3 136 ! 187 ! 188 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 189 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 190 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) 191 ENDIF 192 ELSE ! only mpi subdomains with errors are here -> STOP now 193 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 194 ENDIF 195 ! 196 ENDIF 197 ! 198 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... 199 ngrdstop = Agrif_Fixed() ! store which grid got this error 200 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock 137 201 ENDIF 138 202 ! … … 140 204 ! 141 205 END SUBROUTINE stp_ctl 206 207 208 SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 209 !!---------------------------------------------------------------------- 210 !! *** ROUTINE wrt_line *** 211 !! 212 !! ** Purpose : write information line 213 !! 214 !!---------------------------------------------------------------------- 215 CHARACTER(len=*), INTENT( out) :: cdline 216 CHARACTER(len=*), INTENT(in ) :: cdprefix 217 REAL(wp), INTENT(in ) :: pval 218 INTEGER, DIMENSION(3), INTENT(in ) :: kloc 219 INTEGER, INTENT(in ) :: kt, ksum, kmin, kmax 220 ! 221 CHARACTER(len=80) :: clsuff 222 CHARACTER(len=9 ) :: clkt, clsum, clmin, clmax 223 CHARACTER(len=9 ) :: cli, clj, clk 224 CHARACTER(len=1 ) :: clfmt 225 CHARACTER(len=4 ) :: cl4 ! needed to be able to compile with Agrif, I don't know why 226 INTEGER :: ifmtk 227 !!---------------------------------------------------------------------- 228 WRITE(clkt , '(i9)') kt 229 230 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij ,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 231 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF 232 cl4 = '(i'//clfmt//')' ; WRITE(clsum, cl4) ksum 233 WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 234 cl4 = '(i'//clfmt//')' ; WRITE(clmin, cl4) kmin-1 235 WRITE(clmax, cl4) kmax-1 236 ! 237 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1 ! how many digits to we need to write jpiglo? (we decide max = 9) 238 cl4 = '(i'//clfmt//')' ; WRITE(cli, cl4) kloc(1) ! this is ok with AGRIF 239 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1 ! how many digits to we need to write jpjglo? (we decide max = 9) 240 cl4 = '(i'//clfmt//')' ; WRITE(clj, cl4) kloc(2) ! this is ok with AGRIF 241 ! 242 IF( ksum == 1 ) THEN ; WRITE(clsuff,9100) TRIM(clmin) 243 ELSE ; WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 244 ENDIF 245 IF(kloc(3) == 0) THEN 246 ifmtk = INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 247 clk = REPEAT(' ', ifmtk) ! create the equivalent in blank string 248 WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 249 ELSE 250 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 251 !!! WRITE(clk, '(i'//clfmt//')') kloc(3) ! this is creating a compilation error with AGRIF 252 cl4 = '(i'//clfmt//')' ; WRITE(clk, cl4) kloc(3) ! this is ok with AGRIF 253 WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), TRIM(clk), TRIM(clsuff) 254 ENDIF 255 ! 256 9100 FORMAT('MPI rank ', a) 257 9200 FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 258 9300 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j ', a, ' ', a, ' ', a, ' ', a) 259 9400 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 260 ! 261 END SUBROUTINE wrt_line 262 142 263 143 264 !!====================================================================== -
NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/tests/STATION_ASF/README.md
r12031 r13159 1 1 2 2 ## WARNING: TOTALLY-ALPHA-STUFF / DOCUMENT IN THE PROCESS OF BEING WRITEN! 3 4 NOTE: if working with the trunk of NEMO, you are strongly advised to use the same test-case but on the `NEMO-examples` GitHub depo: 5 https://github.com/NEMO-ocean/NEMO-examples/tree/master/STATION_ASF 6 3 7 4 8 # *Station Air-Sea Fluxes* demonstration case
Note: See TracChangeset
for help on using the changeset viewer.