- Timestamp:
- 2020-06-17T13:01:47+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src
- Files:
-
- 23 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/DIA/diaar5.F90
r12630 r13121 77 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 78 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpe, z2d ! 2D workspace 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrhd , z rhop, ztpot! 3D workspace79 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrhd , ztpot ! 3D workspace 80 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace 81 81 … … 87 87 IF( l_ar5 ) THEN 88 88 ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) ) 89 ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk))89 ALLOCATE( zrhd(jpi,jpj,jpk) ) 90 90 ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) 91 91 zarea_ssh(:,:) = e1e2t(:,:) * ssh(:,:,Kmm) … … 155 155 156 156 ! ! steric sea surface height 157 CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, gdept(:,:,:,Kmm) ) ! now in situ and potential density158 zrhop(:,:,jpk) = 0._wp159 CALL iom_put( 'rhop', zrhop )160 !161 157 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 162 158 DO jk = 1, jpkm1 163 zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk)159 zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * rhd(:,:,jk) 164 160 END DO 165 161 IF( ln_linssh ) THEN … … 168 164 DO jj = 1,jpj 169 165 iks = mikt(ji,jj) 170 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj)166 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * rhd(ji,jj,iks) + riceload(ji,jj) 171 167 END DO 172 168 END DO 173 169 ELSE 174 zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1)170 zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * rhd(:,:,1) 175 171 END IF 176 172 END IF … … 293 289 IF( l_ar5 ) THEN 294 290 DEALLOCATE( zarea_ssh , zbotpres, z2d ) 295 DEALLOCATE( zrhd , zrhop )296 291 DEALLOCATE( ztsn ) 297 292 ENDIF … … 367 362 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) .OR. & 368 363 & iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) .OR. & 369 & iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) L_ar5 = .TRUE. 364 & iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) .OR. & 365 & iom_use( 'rhop' ) ) L_ar5 = .TRUE. 370 366 371 367 IF( l_ar5 ) THEN -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/DIA/diawri.F90
r12933 r13121 171 171 CALL iom_put( "sbs", z2d ) ! bottom salinity 172 172 ENDIF 173 174 CALL iom_put( "rhop", rhop(:,:,:) ) ! 3D potential density (sigma0) 173 175 174 176 IF ( iom_use("taubot") ) THEN ! bottom stress -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/DOM/dommsk.F90
r12377 r13121 259 259 ENDIF 260 260 END DO 261 #if defined key_agrif262 IF( .NOT. AGRIF_Root() ) THEN263 IF ((nbondi == 1).OR.(nbondi == 2)) fmask(nlci-1 , : ,jk) = 0.e0 ! east264 IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1 , : ,jk) = 0.e0 ! west265 IF ((nbondj == 1).OR.(nbondj == 2)) fmask(: ,nlcj-1 ,jk) = 0.e0 ! north266 IF ((nbondj == -1).OR.(nbondj == 2)) fmask(: ,1 ,jk) = 0.e0 ! south267 ENDIF268 #endif269 261 END DO 270 262 ! -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/DOM/istate.F90
r12489 r13121 24 24 USE dom_oce ! ocean space and time domain 25 25 USE daymod ! calendar 26 USE divhor ! horizontal divergence (div_hor routine)27 26 USE dtatsd ! data temperature and salinity (dta_tsd routine) 28 27 USE dtauvd ! data: U & V current (dta_uvd routine) … … 121 120 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 122 121 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 123 hdiv(:,:,jpk) = 0._wp ! bottom divergence set one for 0 to zero at jpk level124 CALL div_hor( 0, Kbb, Kmm ) ! compute interior hdiv value125 !!gm hdiv(:,:,:) = 0._wp126 122 127 123 !!gm POTENTIAL BUG : -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/DYN/divhor.F90
r12377 r13121 84 84 END_3D 85 85 ! 86 #if defined key_agrif87 IF( .NOT. Agrif_Root() ) THEN88 IF( nbondi == -1 .OR. nbondi == 2 ) hdiv( 2 , : ,:) = 0._wp ! west89 IF( nbondi == 1 .OR. nbondi == 2 ) hdiv( nlci-1, : ,:) = 0._wp ! east90 IF( nbondj == -1 .OR. nbondj == 2 ) hdiv( : , 2 ,:) = 0._wp ! south91 IF( nbondj == 1 .OR. nbondj == 2 ) hdiv( : ,nlcj-1,:) = 0._wp ! north92 ENDIF93 #endif94 !95 86 IF( ln_rnf ) CALL sbc_rnf_div( hdiv, Kmm ) !== runoffs ==! (update hdiv field) 96 87 ! -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/DYN/sshwzv.F90
r12489 r13121 202 202 #if defined key_agrif 203 203 IF( .NOT. AGRIF_Root() ) THEN 204 IF ((nbondi == 1).OR.(nbondi == 2)) pww(nlci-1 , : ,:) = 0.e0 ! east 205 IF ((nbondi == -1).OR.(nbondi == 2)) pww(2 , : ,:) = 0.e0 ! west 206 IF ((nbondj == 1).OR.(nbondj == 2)) pww(: ,nlcj-1 ,:) = 0.e0 ! north 207 IF ((nbondj == -1).OR.(nbondj == 2)) pww(: ,2 ,:) = 0.e0 ! south 204 ! Mask vertical velocity at first/last columns/row 205 ! inside computational domain (cosmetic) 206 ! --- West --- ! 207 DO ji = mi0(2), mi1(2) 208 DO jj = 1, jpj 209 pww(ji,jj,:) = 0._wp 210 ENDDO 211 ENDDO 212 ! 213 ! --- East --- ! 214 DO ji = mi0(jpiglo-1), mi1(jpiglo-1) 215 DO jj = 1, jpj 216 pww(ji,jj,:) = 0._wp 217 ENDDO 218 ENDDO 219 ! 220 ! --- South --- ! 221 DO jj = mj0(2), mj1(2) 222 DO ji = 1, jpi 223 pww(ji,jj,:) = 0._wp 224 ENDDO 225 ENDDO 226 ! 227 ! --- North --- ! 228 DO jj = mj0(jpjglo-1), mj1(jpjglo-1) 229 DO ji = 1, jpi 230 pww(ji,jj,:) = 0._wp 231 ENDDO 232 ENDDO 208 233 ENDIF 209 234 #endif -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/ICB/icbrst.F90
r12933 r13121 192 192 CHARACTER(len=256) :: cl_path 193 193 CHARACTER(len=256) :: cl_filename 194 CHARACTER(len= 256) :: cl_kt194 CHARACTER(len=8 ) :: cl_kt 195 195 CHARACTER(LEN=12 ) :: clfmt ! writing format 196 196 TYPE(iceberg), POINTER :: this … … 213 213 ! file name 214 214 WRITE(cl_kt, '(i8.8)') kt 215 cl_filename = TRIM(cexper)//"_"// TRIM(ADJUSTL(cl_kt))//"_"//TRIM(cn_icbrst_out)215 cl_filename = TRIM(cexper)//"_"//cl_kt//"_"//TRIM(cn_icbrst_out) 216 216 IF( lk_mpp ) THEN 217 idg = MAX( INT(LOG10(REAL( jpnij-1,wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9218 WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg ! '(a,a,ix.x,a)'219 WRITE(cl_filename, clfmt) TRIM(cl_filename), '_', narea-1, '.nc'217 idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 218 WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg ! '(a,a,ix.x,a)' 219 WRITE(cl_filename, clfmt) TRIM(cl_filename), '_', narea-1, '.nc' 220 220 ELSE 221 WRITE(cl_filename,'( A,".nc")') TRIM(cl_filename)221 WRITE(cl_filename,'(a,a)') TRIM(cl_filename), '.nc' 222 222 ENDIF 223 223 -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/ICB/icbtrj.F90
r12933 r13121 66 66 CHARACTER(len=80) :: cl_filename 67 67 CHARACTER(LEN=12) :: clfmt ! writing format 68 CHARACTER(LEN= 20) :: cldate_ini, cldate_end68 CHARACTER(LEN=8 ) :: cldate_ini, cldate_end 69 69 TYPE(iceberg), POINTER :: this 70 70 TYPE(point) , POINTER :: pt … … 82 82 83 83 ! define trajectory output name 84 cl_filename = 'trajectory_icebergs_'// TRIM(ADJUSTL(cldate_ini))//'-'//TRIM(ADJUSTL(cldate_end))84 cl_filename = 'trajectory_icebergs_'//cldate_ini//'-'//cldate_end 85 85 IF ( lk_mpp ) THEN 86 idg = MAX( INT(LOG10(REAL( jpnij-1,wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=987 WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg ! '(a,a,ix.x,a)'88 WRITE(cl_filename, clfmt) TRIM(cl_filename), '_', narea-1, '.nc'86 idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 87 WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg ! '(a,a,ix.x,a)' 88 WRITE(cl_filename, clfmt) TRIM(cl_filename), '_', narea-1, '.nc' 89 89 ELSE 90 WRITE(cl_filename,'( A,".nc")') TRIM(cl_filename)90 WRITE(cl_filename,'(a,a)') TRIM(cl_filename), '.nc' 91 91 ENDIF 92 92 IF( lwp .AND. nn_verbose_level >= 0 ) WRITE(numout,'(2a)') 'icebergs, icb_trj_init: creating ',TRIM(cl_filename) -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/IOM/iom_def.F90
r12649 r13121 33 33 INTEGER, PARAMETER, PUBLIC :: jpmax_vars = 1200 !: maximum number of variables in one file 34 34 INTEGER, PARAMETER, PUBLIC :: jpmax_dims = 4 !: maximum number of dimensions for one variable 35 INTEGER, PARAMETER, PUBLIC :: jpmax_digits = 5!: maximum number of digits for the cpu number in the file name35 INTEGER, PARAMETER, PUBLIC :: jpmax_digits = 9 !: maximum number of digits for the cpu number in the file name 36 36 37 37 -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/IOM/iom_nf90.F90
r12933 r13121 111 111 IF( ldwrt ) THEN !* the file should be open in write mode so we create it... 112 112 IF( jpnij > 1 ) THEN 113 idg = MAX( INT(LOG10(REAL( jpnij-1,wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9114 WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg ! '(a,a,ix.x,a)'113 idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 114 WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg ! '(a,a,ix.x,a)' 115 115 WRITE(cltmp,clfmt) cdname(1:iln-1), '_', narea-1, '.nc' 116 116 cdname = TRIM(cltmp) -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/LBC/lib_mpp.F90
r12933 r13121 1114 1114 ! 1115 1115 CHARACTER(LEN=8) :: clfmt ! writing format 1116 INTEGER :: inum 1117 INTEGER :: idg ! number of digits 1116 INTEGER :: inum 1118 1117 !!---------------------------------------------------------------------- 1119 1118 ! 1120 1119 nstop = nstop + 1 1121 1120 ! 1122 IF( numout == 6 ) THEN ! force to open ocean.output file if not already opened 1123 CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 1124 ELSE 1125 IF( narea > 1 .AND. cd1 == 'STOP' ) THEN ! add an error message in ocean.output 1126 CALL ctl_opn( inum,'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 1127 WRITE(inum,*) 1128 idg = MAX( INT(LOG10(REAL(jpnij-1,wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 1129 WRITE(clfmt, "('(a,i', i1, '.', i1, ')')") idg, idg ! '(a,ix.x)' 1130 WRITE(inum,clfmt) ' ===>>> : see E R R O R in ocean.output_', narea - 1 1131 ENDIF 1121 IF( cd1 == 'STOP' .AND. narea /= 1 ) THEN ! Immediate stop: add an arror message in 'ocean.output' file 1122 CALL ctl_opn( inum, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 1123 WRITE(inum,*) 1124 WRITE(inum,*) ' ==>>> Look for "E R R O R" messages in all existing *ocean.output* files' 1125 CLOSE(inum) 1126 ENDIF 1127 IF( numout == 6 ) THEN ! force to open ocean.output file if not already opened 1128 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 1132 1129 ENDIF 1133 1130 ! … … 1224 1221 CHARACTER(LEN=10) :: clfmt ! writing format 1225 1222 INTEGER :: iost 1226 INTEGER :: idg ! number of digits1223 INTEGER :: idg ! number of digits 1227 1224 !!---------------------------------------------------------------------- 1228 1225 ! … … 1232 1229 IF( PRESENT( karea ) ) THEN 1233 1230 IF( karea > 1 ) THEN 1234 idg = MAX( INT(LOG10(REAL(jpnij-1,wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 1235 WRITE(clfmt, "('(a,a,i', i1, '.', i1, ')')") idg, idg ! '(a,a,ix.x)' 1231 ! Warning: jpnij is maybe not already defined when calling ctl_opn -> use mppsize instead of jpnij 1232 idg = MAX( INT(LOG10(REAL(MAX(1,mppsize-1),wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 1233 WRITE(clfmt, "('(a,a,i', i1, '.', i1, ')')") idg, idg ! '(a,a,ix.x)' 1236 1234 WRITE(clfile, clfmt) TRIM(clfile), '_', karea-1 1237 1235 ENDIF -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/SBC/sbcblk.F90
r12925 r13121 628 628 END SELECT 629 629 630 CALL iom_put("Cd_oce", zcd_oce) 631 CALL iom_put("Ce_oce", zce_oce) 632 CALL iom_put("Ch_oce", zch_oce) 633 630 634 IF( ln_skin_cs .OR. ln_skin_wl ) THEN 631 635 !! ptsk and pssq have been updated!!! … … 878 882 Ce_ice(:,:) = Ch_ice(:,:) ! sensible and latent heat transfer coef. are considered identical 879 883 ENDIF 880 881 !! IF ( iom_use("Cd_ice") ) CALL iom_put("Cd_ice", Cd_ice) ! output value of pure ice-atm. transfer coef. 882 !! IF ( iom_use("Ch_ice") ) CALL iom_put("Ch_ice", Ch_ice) ! output value of pure ice-atm. transfer coef. 883 884 885 CALL iom_put("Cd_ice", Cd_ice) 886 CALL iom_put("Ce_ice", Ce_ice) 887 CALL iom_put("Ch_ice", Ch_ice) 888 884 889 ! local scalars ( place there for vector optimisation purposes) 885 890 zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:) -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/SBC/sbccpl.F90
r12952 r13121 1785 1785 ENDDO 1786 1786 ELSE 1787 qns_tot(:,:) =qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1787 zqns_tot(:,:) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1788 1788 DO jl = 1, jpl 1789 zqns_tot(:,: ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1790 1789 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1791 1790 END DO … … 1928 1927 END DO 1929 1928 ELSE 1930 qsr_tot(:,: ) =qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1929 zqsr_tot(:,:) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1931 1930 DO jl = 1, jpl 1932 zqsr_tot(:,: ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1933 1931 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1934 1932 END DO -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/SBC/sbcmod.F90
r12489 r13121 120 120 ncom_fsbc = nn_fsbc ! make nn_fsbc available for lib_mpp 121 121 #endif 122 ! !* overwrite namelist parameter using CPP key information123 #if defined key_agrif124 IF( Agrif_Root() ) THEN ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid)125 IF( lk_si3 ) nn_ice = 2126 IF( lk_cice ) nn_ice = 3127 ENDIF128 !!GS: TBD129 !#else130 ! IF( lk_si3 ) nn_ice = 2131 ! IF( lk_cice ) nn_ice = 3132 #endif133 122 ! 134 123 IF(lwp) THEN !* Control print -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/SBC/sbcwave.F90
r12377 r13121 210 210 END_3D 211 211 ! 212 #if defined key_agrif213 IF( .NOT. Agrif_Root() ) THEN214 IF( nbondi == -1 .OR. nbondi == 2 ) ze3divh( 2:nbghostcells+1,: ,:) = 0._wp ! west215 IF( nbondi == 1 .OR. nbondi == 2 ) ze3divh( nlci-nbghostcells:nlci-1,:,:) = 0._wp ! east216 IF( nbondj == -1 .OR. nbondj == 2 ) ze3divh( :,2:nbghostcells+1 ,:) = 0._wp ! south217 IF( nbondj == 1 .OR. nbondj == 2 ) ze3divh( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp ! north218 ENDIF219 #endif220 !221 212 CALL lbc_lnk( 'sbcwave', ze3divh, 'T', 1. ) 222 213 ! -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/TRD/trdtra.F90
r12489 r13121 82 82 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! now tracer variable 83 83 ! 84 INTEGER :: jk ! loop indices 84 INTEGER :: jk ! loop indices 85 INTEGER :: i01 ! 0 or 1 85 86 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrds ! 3D workspace 86 87 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwt, zws, ztrdt ! 3D workspace … … 90 91 IF( trd_tra_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' ) 91 92 ENDIF 92 93 ! 94 i01 = COUNT( (/ PRESENT(pu) .OR. ( ktrd /= jptra_xad .AND. ktrd /= jptra_yad .AND. ktrd /= jptra_zad ) /) ) 95 ! 93 96 IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN !== Temperature trend ==! 94 97 ! 95 SELECT CASE( ktrd )98 SELECT CASE( ktrd*i01 ) 96 99 ! ! advection: transform the advective flux into a trend 97 100 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd, pu, ptra, 'X', trdtx, Kmm ) … … 112 115 IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN !== Salinity trends ==! 113 116 ! 114 SELECT CASE( ktrd )117 SELECT CASE( ktrd*i01 ) 115 118 ! ! advection: transform the advective flux into a trend 116 119 ! ! and send T & S trends to trd_tra_mng … … 163 166 IF( ctype == 'TRC' ) THEN !== passive tracer trend ==! 164 167 ! 165 SELECT CASE( ktrd )168 SELECT CASE( ktrd*i01 ) 166 169 ! ! advection: transform the advective flux into a masked trend 167 170 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'X', ztrds, Kmm ) -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/ZDF/zdftke.F90
r12702 r13121 45 45 USE zdfdrg ! vertical physics: top/bottom drag coef. 46 46 USE zdfmxl ! vertical physics: mixed layer 47 #if defined key_si3 48 USE ice, ONLY: hm_i, h_i 49 #endif 50 #if defined key_cice 51 USE sbc_ice, ONLY: h_i 52 #endif 47 53 ! 48 54 USE in_out_manager ! I/O manager … … 64 70 INTEGER :: nn_mxl ! type of mixing length (=0/1/2/3) 65 71 REAL(wp) :: rn_mxl0 ! surface min value of mixing length (kappa*z_o=0.4*0.1 m) [m] 72 INTEGER :: nn_mxlice ! type of scaling under sea-ice 73 REAL(wp) :: rn_mxlice ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 66 74 INTEGER :: nn_pdl ! Prandtl number or not (ratio avt/avm) (=0/1) 67 75 REAL(wp) :: rn_ediff ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e) … … 422 430 REAL(wp) :: zrn2, zraug, zcoef, zav ! local scalars 423 431 REAL(wp) :: zdku, zdkv, zsqen ! - - 424 REAL(wp) :: zemxl, zemlm, zemlp ! - -432 REAL(wp) :: zemxl, zemlm, zemlp, zmaxice ! - - 425 433 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxlm, zmxld ! 3D workspace 426 434 !!-------------------------------------------------------------------- … … 436 444 zmxld(:,:,:) = rmxl_min 437 445 ! 438 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 446 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 447 ! 439 448 zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 449 #if ! defined key_si3 && ! defined key_cice 440 450 DO_2D_00_00 441 zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1))451 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 442 452 END_2D 443 ELSE 453 #else 454 SELECT CASE( nn_mxlice ) ! Type of scaling under sea-ice 455 ! 456 CASE( 0 ) ! No scaling under sea-ice 457 DO_2D_00_00 458 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 459 END_2D 460 ! 461 CASE( 1 ) ! scaling with constant sea-ice thickness 462 DO_2D_00_00 463 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) 464 END_2D 465 ! 466 CASE( 2 ) ! scaling with mean sea-ice thickness 467 DO_2D_00_00 468 #if defined key_si3 469 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * hm_i(ji,jj) * 2. ) * tmask(ji,jj,1) 470 #elif defined key_cice 471 zmaxice = MAXVAL( h_i(ji,jj,:) ) 472 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 473 #endif 474 END_2D 475 ! 476 CASE( 3 ) ! scaling with max sea-ice thickness 477 DO_2D_00_00 478 zmaxice = MAXVAL( h_i(ji,jj,:) ) 479 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 480 END_2D 481 ! 482 END SELECT 483 #endif 484 ! 485 DO_2D_00_00 486 zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 487 END_2D 488 ! 489 ELSE 444 490 zmxlm(:,:,1) = rn_mxl0 445 491 ENDIF 492 446 493 ! 447 494 DO_3D_00_00( 2, jpkm1 ) … … 547 594 INTEGER :: ios 548 595 !! 549 NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin , & 550 & rn_emin0, rn_bshear, nn_mxl , ln_mxl0 , & 551 & rn_mxl0 , nn_pdl , ln_drg , ln_lc , rn_lc, & 552 & nn_etau , nn_htau , rn_efr , rn_eice 596 NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin , & 597 & rn_emin0, rn_bshear, nn_mxl , ln_mxl0 , & 598 & rn_mxl0 , nn_mxlice, rn_mxlice, & 599 & nn_pdl , ln_drg , ln_lc , rn_lc, & 600 & nn_etau , nn_htau , rn_efr , rn_eice 553 601 !!---------------------------------------------------------------------- 554 602 ! … … 576 624 WRITE(numout,*) ' mixing length type nn_mxl = ', nn_mxl 577 625 WRITE(numout,*) ' surface mixing length = F(stress) or not ln_mxl0 = ', ln_mxl0 626 IF( ln_mxl0 ) THEN 627 WRITE(numout,*) ' type of scaling under sea-ice nn_mxlice = ', nn_mxlice 628 IF( nn_mxlice == 1 ) & 629 WRITE(numout,*) ' ice thickness when scaling under sea-ice rn_mxlice = ', rn_mxlice 630 ENDIF 578 631 WRITE(numout,*) ' surface mixing length minimum value rn_mxl0 = ', rn_mxl0 579 632 WRITE(numout,*) ' top/bottom friction forcing flag ln_drg = ', ln_drg -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/nemogcm.F90
r12933 r13121 232 232 IF( ngrdstop > 0 ) THEN 233 233 WRITE(ctmp9,'(i2)') ngrdstop 234 WRITE(ctmp2,*) ' ==>>> Errordetected in Agrif grid '//TRIM(ctmp9)235 WRITE(ctmp3,*) ' ==>>> look for error messages in'//TRIM(ctmp9)//'_ocean_output* files'236 CALL ctl_stop( ctmp1, ctmp2, ctmp3 )234 WRITE(ctmp2,*) ' E R R O R detected in Agrif grid '//TRIM(ctmp9) 235 WRITE(ctmp3,*) ' Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 236 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 237 237 ELSE 238 CALL ctl_stop( ctmp1 ) 238 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 239 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 239 240 ENDIF 240 241 ENDIF … … 249 250 #else 250 251 IF ( lk_oasis ) THEN ; CALL cpl_finalize ! end coupling and mpp communications with OASIS 251 ELSEIF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications252 ELSEIF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications 252 253 ENDIF 253 254 #endif -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/stpctl.F90
r12933 r13121 130 130 zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! minus salinity max 131 131 zmax(4) = MAXVAL( ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! salinity max 132 IF( ll_colruns ) THEN ! following variables are used only in the netcdf file132 IF( ll_colruns .OR. jpnij == 1 ) THEN ! following variables are used only in the netcdf file 133 133 zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! minus temperature max 134 134 zmax(6) = MAXVAL( ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! temperature max … … 220 220 ! 221 221 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 222 IF(lwp) CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 222 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 223 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) 224 ENDIF 223 225 ELSE ! only mpi subdomains with errors are here -> STOP now 224 226 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 225 227 ENDIF 226 228 ! 227 IF( nstop == 0 ) nstop = 1 228 ngrdstop = Agrif_Fixed() 229 ! 229 ENDIF 230 ! 231 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... 232 ngrdstop = Agrif_Fixed() ! store which grid got this error 233 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock 230 234 ENDIF 231 235 ! … … 260 264 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF 261 265 cl4 = '(i'//clfmt//')' ; WRITE(clsum, cl4) ksum 262 WRITE(clfmt, '(i1)') INT(LOG10(REAL( jpnij-1,wp))) + 1! how many digits to we need to write ? (we decide max = 9)266 WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 263 267 cl4 = '(i'//clfmt//')' ; WRITE(clmin, cl4) kmin-1 264 268 WRITE(clmax, cl4) kmax-1 -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OFF/nemogcm.F90
r12933 r13121 147 147 IF( nstop /= 0 .AND. lwp ) THEN ! error print 148 148 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 149 CALL ctl_stop( ctmp1 ) 149 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 150 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 150 151 ENDIF 151 152 ! -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/SAS/nemogcm.F90
r12933 r13121 162 162 IF( ngrdstop > 0 ) THEN 163 163 WRITE(ctmp9,'(i2)') ngrdstop 164 WRITE(ctmp2,*) ' ==>>> Errordetected in Agrif grid '//TRIM(ctmp9)165 WRITE(ctmp3,*) ' ==>>> look for error messages in'//TRIM(ctmp9)//'_ocean_output* files'166 CALL ctl_stop( ctmp1, ctmp2, ctmp3 )164 WRITE(ctmp2,*) ' E R R O R detected in Agrif grid '//TRIM(ctmp9) 165 WRITE(ctmp3,*) ' Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 166 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 167 167 ELSE 168 CALL ctl_stop( ctmp1 ) 168 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 169 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 169 170 ENDIF 170 171 ENDIF -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/SAS/stpctl.F90
r12933 r13121 180 180 ! 181 181 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 182 IF(lwp) CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 182 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 183 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) 184 ENDIF 183 185 ELSE ! only mpi subdomains with errors are here -> STOP now 184 186 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 185 187 ENDIF 186 188 ! 187 IF( nstop == 0 ) nstop = 1 188 ngrdstop = Agrif_Fixed() 189 ! 189 ENDIF 190 ! 191 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... 192 ngrdstop = Agrif_Fixed() ! store which grid got this error 193 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock 190 194 ENDIF 191 195 ! … … 220 224 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF 221 225 cl4 = '(i'//clfmt//')' ; WRITE(clsum, cl4) ksum 222 WRITE(clfmt, '(i1)') INT(LOG10(REAL( jpnij-1,wp))) + 1! how many digits to we need to write ? (we decide max = 9)226 WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 223 227 cl4 = '(i'//clfmt//')' ; WRITE(clmin, cl4) kmin-1 224 228 WRITE(clmax, cl4) kmax-1 -
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/TOP/PISCES/P4Z/p4zsms.F90
r12489 r13121 206 206 IF( l_trdtrc ) THEN 207 207 DO jn = jp_pcs0, jp_pcs1 208 ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfact 2r208 ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfactr 209 209 CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends 210 210 END DO
Note: See TracChangeset
for help on using the changeset viewer.