Changeset 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/trasbc.F90
- Timestamp:
- 2021-05-05T13:18:04+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/TRA/trasbc.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev _r12970_AGRIF_CMEMSext/AGRIF5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 ^/vendors/PPR@HEAD ext/PPR 8 9 9 10 # SETTE 10 ^/utils/CI/sette@1 3559sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/trasbc.F90
r13497 r14789 9 9 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) Forcing averaged over 2 time steps 10 10 !! - ! 2010-09 (C. Ethe, G. Madec) Merge TRA-TRC 11 !! 3.6 ! 2014-11 (P. Mathiot) isf melting forcing 11 !! 3.6 ! 2014-11 (P. Mathiot) isf melting forcing 12 12 !! 4.1 ! 2019-09 (P. Mathiot) isf moved in traisf 13 13 !!---------------------------------------------------------------------- … … 21 21 USE phycst ! physical constant 22 22 USE eosbn2 ! Equation Of State 23 USE sbcmod ! ln_rnf 24 USE sbcrnf ! River runoff 23 USE sbcmod ! ln_rnf 24 USE sbcrnf ! River runoff 25 25 USE traqsr ! solar radiation penetration 26 26 USE trd_oce ! trends: ocean variables 27 USE trdtra ! trends manager: tracers 28 #if defined key_asminc 27 USE trdtra ! trends manager: tracers 28 #if defined key_asminc 29 29 USE asminc ! Assimilation increment 30 30 #endif … … 54 54 !!---------------------------------------------------------------------- 55 55 !! *** ROUTINE tra_sbc *** 56 !! 56 !! 57 57 !! ** Purpose : Compute the tracer surface boundary condition trend of 58 58 !! (flux through the interface, concentration/dilution effect) 59 59 !! and add it to the general trend of tracer equations. 60 60 !! 61 !! ** Method : The (air+ice)-sea flux has two components: 62 !! (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface); 63 !! (2) Fwe , tracer carried with the water that is exchanged with air+ice. 61 !! ** Method : The (air+ice)-sea flux has two components: 62 !! (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface); 63 !! (2) Fwe , tracer carried with the water that is exchanged with air+ice. 64 64 !! The input forcing fields (emp, rnf, sfx) contain Fext+Fwe, 65 65 !! they are simply added to the tracer trend (ts(Krhs)). … … 69 69 !! concentration/dilution effect associated with water exchanges. 70 70 !! 71 !! ** Action : - Update ts(Krhs) with the surface boundary condition trend 71 !! ** Action : - Update ts(Krhs) with the surface boundary condition trend 72 72 !! - send trends to trdtra module for further diagnostics(l_trdtra=T) 73 73 !!---------------------------------------------------------------------- 74 INTEGER, INTENT(in ) :: kt ! ocean time-step index75 INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices76 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation77 ! 78 INTEGER :: ji, jj, jk, jn ! dummy loop indices79 INTEGER :: ikt, ikb 80 REAL(wp) :: zfact, z1_e3t, zdep, ztim ! local scalar74 INTEGER, INTENT(in ) :: kt ! ocean time-step index 75 INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices 76 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer Eq. 77 ! 78 INTEGER :: ji, jj, jk, jn ! dummy loop indices 79 INTEGER :: ikt, ikb, isi, iei, isj, iej ! local integers 80 REAL(wp) :: zfact, z1_e3t, zdep, ztim ! local scalar 81 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 82 82 !!---------------------------------------------------------------------- … … 84 84 IF( ln_timing ) CALL timing_start('tra_sbc') 85 85 ! 86 IF( kt == nit000 ) THEN 87 IF(lwp) WRITE(numout,*) 88 IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition' 89 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 86 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 87 IF( kt == nit000 ) THEN 88 IF(lwp) WRITE(numout,*) 89 IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition' 90 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 91 ENDIF 90 92 ENDIF 91 93 ! 92 94 IF( l_trdtra ) THEN !* Save ta and sa trends 93 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )95 ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 94 96 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 95 97 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 96 98 ENDIF 97 99 ! 100 IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF ! Avoid double-counting when using tiling 101 IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF 102 IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF 103 IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF 104 98 105 !!gm This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 99 106 IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration 100 qns(:,:) = qns(:,:) + qsr(:,:) ! total heat flux in qns 101 qsr(:,:) = 0._wp ! qsr set to zero 107 DO_2D( isi, iei, isj, iej ) 108 qns(ji,jj) = qns(ji,jj) + qsr(ji,jj) ! total heat flux in qns 109 qsr(ji,jj) = 0._wp ! qsr set to zero 110 END_2D 102 111 ENDIF 103 112 … … 107 116 ! !== Set before sbc tracer content fields ==! 108 117 IF( kt == nit000 ) THEN !* 1st time-step 109 IF( ln_rstart .AND. & ! Restart: read in restart file 110 & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN 111 IF(lwp) WRITE(numout,*) ' nit000-1 sbc tracer content field read in the restart file' 118 IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN ! Restart: read in restart file 112 119 zfact = 0.5_wp 113 sbc_tsc(:,:,:) = 0._wp 114 CALL iom_get( numror, jpdom_auto, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios ) ! before heat content sbc trend 115 CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios ) ! before salt content sbc trend 116 ELSE ! No restart or restart not found: Euler forward time stepping 120 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 121 IF(lwp) WRITE(numout,*) ' nit000-1 sbc tracer content field read in the restart file' 122 sbc_tsc(:,:,:) = 0._wp 123 CALL iom_get( numror, jpdom_auto, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) ) ! before heat content sbc trend 124 CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) ) ! before salt content sbc trend 125 ENDIF 126 ELSE ! No restart or restart not found: Euler forward time stepping 117 127 zfact = 1._wp 118 sbc_tsc(:,:,:) = 0._wp 119 sbc_tsc_b(:,:,:) = 0._wp 128 DO_2D( isi, iei, isj, iej ) 129 sbc_tsc(ji,jj,:) = 0._wp 130 sbc_tsc_b(ji,jj,:) = 0._wp 131 END_2D 120 132 ENDIF 121 133 ELSE !* other time-steps: swap of forcing fields 122 134 zfact = 0.5_wp 123 sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 135 DO_2D( isi, iei, isj, iej ) 136 sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:) 137 END_2D 124 138 ENDIF 125 139 ! !== Now sbc tracer content fields ==! 126 DO_2D( 0, 1, 0, 0)140 DO_2D( isi, iei, isj, iej ) 127 141 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux 128 142 sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting 129 143 END_2D 130 IF( ln_linssh ) THEN !* linear free surface 131 DO_2D( 0, 1, 0, 0) !==>> add concentration/dilution effect due to constant volume cell144 IF( ln_linssh ) THEN !* linear free surface 145 DO_2D( isi, iei, isj, iej ) !==>> add concentration/dilution effect due to constant volume cell 132 146 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 133 147 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) 134 148 END_2D !==>> output c./d. term 135 IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 136 IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 149 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 150 IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 151 IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 152 ENDIF 137 153 ENDIF 138 154 ! 139 155 DO jn = 1, jpts !== update tracer trend ==! 140 DO_2D( 0, 1, 0, 0 )156 DO_2D( 0, 0, 0, 0 ) 141 157 pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) & 142 158 & / e3t(ji,jj,1,Kmm) 143 159 END_2D 144 160 END DO 145 ! 146 IF( lrst_oce ) THEN !== write sbc_tsc in the ocean restart file ==!147 IF( l wxios ) CALL iom_swap( cwxios_context )148 CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem), ldxios = lwxios)149 CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal), ldxios = lwxios)150 IF( lwxios ) CALL iom_swap( cxios_context )161 ! 162 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 163 IF( lrst_oce ) THEN !== write sbc_tsc in the ocean restart file ==! 164 CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) ) 165 CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) ) 166 ENDIF 151 167 ENDIF 152 168 ! … … 155 171 !---------------------------------------- 156 172 ! 157 IF( ln_rnf ) THEN ! input of heat and salt due to river runoff 173 IF( ln_rnf ) THEN ! input of heat and salt due to river runoff 158 174 zfact = 0.5_wp 159 DO_2D( 0, 1, 0, 0 )175 DO_2D( 0, 0, 0, 0 ) 160 176 IF( rnf(ji,jj) /= 0._wp ) THEN 161 177 zdep = zfact / h_rnf(ji,jj) … … 164 180 & + ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep 165 181 IF( ln_rnf_sal ) pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 166 & + ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 182 & + ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 167 183 END DO 168 184 ENDIF … … 170 186 ENDIF 171 187 172 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst 173 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss 188 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 189 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst 190 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss 191 ENDIF 174 192 175 193 #if defined key_asminc … … 181 199 IF( ln_sshinc ) THEN ! input of heat and salt due to assimilation 182 200 ! 183 IF( ln_linssh ) THEN 184 DO_2D( 0, 1, 0, 0 )201 IF( ln_linssh ) THEN 202 DO_2D( 0, 0, 0, 0 ) 185 203 ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm) 186 204 pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim … … 188 206 END_2D 189 207 ELSE 190 DO_2D( 0, 1, 0, 0 )208 DO_2D( 0, 0, 0, 0 ) 191 209 ztim = ssh_iau(ji,jj) / ( ht(ji,jj) + 1. - ssmask(ji, jj) ) 192 210 pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim … … 204 222 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt ) 205 223 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds ) 206 DEALLOCATE( ztrdt , ztrds ) 224 DEALLOCATE( ztrdt , ztrds ) 207 225 ENDIF 208 226 !
Note: See TracChangeset
for help on using the changeset viewer.
