- Timestamp:
- 2021-12-03T20:32:50+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14318_RK3_stage1
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/TRA/trasbc.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14318_RK3_stage1
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette@14244 sette 11 ^/utils/CI/sette@HEAD sette 12
-
- Property svn:externals
-
NEMO/branches/2021/dev_r14318_RK3_stage1/src/OCE/TRA/trasbc.F90
r15379 r15574 40 40 41 41 PUBLIC tra_sbc ! routine called by step.F90 42 PUBLIC tra_sbc_RK3 ! routine called by stprk3_ .F9042 PUBLIC tra_sbc_RK3 ! routine called by stprk3_stg.F90 43 43 44 44 !! * Substitutions … … 52 52 CONTAINS 53 53 54 SUBROUTINE tra_sbc ( kt, Kmm, pts, Krhs , kstg)54 SUBROUTINE tra_sbc ( kt, Kmm, pts, Krhs ) 55 55 !!---------------------------------------------------------------------- 56 56 !! *** ROUTINE tra_sbc *** … … 73 73 !! - send trends to trdtra module for further diagnostics(l_trdtra=T) 74 74 !!---------------------------------------------------------------------- 75 INTEGER, INTENT(in ) :: kt , Kmm, Krhs ! ocean time-step and time-level indices76 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer Eq.77 INTEGER , OPTIONAL , INTENT(in ) :: kstg ! RK3 stage index75 INTEGER, INTENT(in ) :: kt ! ocean time-step index 76 INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices 77 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer Eq. 78 78 ! 79 79 INTEGER :: ji, jj, jk, jn ! dummy loop indices 80 INTEGER :: istg_1, istg_3 ! local integers 81 INTEGER :: ikt, ikb, isi, iei, isj, iej ! - - 80 INTEGER :: ikt, ikb ! local integers 82 81 REAL(wp) :: zfact, z1_e3t, zdep, ztim ! local scalar 83 82 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds … … 86 85 IF( ln_timing ) CALL timing_start('tra_sbc') 87 86 ! 88 IF( PRESENT( kstg ) ) THEN ! RK3 : a few things have to be done at only a specific stage 89 istg_1 = kstg ; istg_3 = kstg 90 ELSE ! MLF : only one call by time step 91 istg_1 = 1 ; istg_3 = 3 92 ENDIF 93 ! 94 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 87 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile 95 88 IF( kt == nit000 ) THEN 96 89 IF(lwp) WRITE(numout,*) … … 106 99 ENDIF 107 100 ! 108 IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF ! Avoid double-counting when using tiling109 IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF110 IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF111 IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF112 113 101 !!gm This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 114 IF( .NOT.ln_traqsr .AND. istg_1 == 1 ) THEN ! no solar radiation penetration (RK3: only at stage 1)115 DO_2D ( isi, iei, isj, iej)116 qns(ji,jj) = qns(ji,jj) + qsr(ji,jj) 117 qsr(ji,jj) = 0._wp 102 IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration 103 DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 104 qns(ji,jj) = qns(ji,jj) + qsr(ji,jj) ! total heat flux in qns 105 qsr(ji,jj) = 0._wp ! qsr set to zero 118 106 END_2D 119 107 ENDIF … … 123 111 !---------------------------------------- 124 112 ! !== Set before sbc tracer content fields ==! 125 zfact = 0.5_wp 126 IF( kt == nit000 .AND. istg_1 == 1 ) THEN !* 1st time-step 113 IF( kt == nit000 ) THEN !* 1st time-step 127 114 IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN ! Restart: read in restart file 128 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 115 zfact = 0.5_wp 116 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile 129 117 IF(lwp) WRITE(numout,*) ' nit000-1 sbc tracer content field read in the restart file' 130 118 sbc_tsc(:,:,:) = 0._wp … … 134 122 ELSE ! No restart or restart not found: Euler forward time stepping 135 123 zfact = 1._wp 136 DO_2D ( isi, iei, isj, iej)124 DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 137 125 sbc_tsc(ji,jj,:) = 0._wp 138 126 sbc_tsc_b(ji,jj,:) = 0._wp 139 127 END_2D 140 128 ENDIF 141 ELSE IF( istg_3 == 3 ) THEN !* other time-steps: swap of forcing fields (RK3: only at stage 3)129 ELSE !* other time-steps: swap of forcing fields 142 130 zfact = 0.5_wp 143 DO_2D ( isi, iei, isj, iej)131 DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 144 132 sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:) 145 133 END_2D 146 #if defined key_RK3147 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile148 IF( lrst_oce ) THEN !== write sbc_tsc in the ocean restart file ==!149 CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) )150 CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) )151 ENDIF152 ENDIF153 #endif154 134 ENDIF 155 135 ! !== Now sbc tracer content fields ==! 156 DO_2D ( isi, iei, isj, iej)136 DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 157 137 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux 158 138 sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting 159 139 END_2D 160 140 IF( ln_linssh ) THEN !* linear free surface 161 DO_2D ( isi, iei, isj, iej) !==>> add concentration/dilution effect due to constant volume cell141 DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) !==>> add concentration/dilution effect due to constant volume cell 162 142 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 163 143 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) 164 144 END_2D !==>> output c./d. term 165 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 166 IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 167 IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 168 ENDIF 145 IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 146 IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 169 147 ENDIF 170 148 ! … … 176 154 END DO 177 155 ! 178 #if ! defined key_RK3 179 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 156 IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile 180 157 IF( lrst_oce ) THEN !== write sbc_tsc in the ocean restart file ==! 181 158 CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) ) … … 183 160 ENDIF 184 161 ENDIF 185 #endif186 162 ! 187 163 !---------------------------------------- … … 193 169 DO_2D( 0, 0, 0, 0 ) 194 170 IF( rnf(ji,jj) /= 0._wp ) THEN 195 !!st - Jerome zdep = zfact / h_rnf(ji,jj)196 #if defined key_RK3197 zdep = 1._wp / h_rnf(ji,jj)198 DO jk = 1, nk_rnf(ji,jj)199 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + rnf_tsc(ji,jj,jp_tem) * zdep200 IF( ln_rnf_sal ) pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) + rnf_tsc(ji,jj,jp_sal) * zdep201 END DO202 203 #else204 171 zdep = zfact / h_rnf(ji,jj) 205 172 DO jk = 1, nk_rnf(ji,jj) … … 209 176 & + ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 210 177 END DO 211 #endif212 !!st213 178 ENDIF 214 179 END_2D 215 180 ENDIF 216 181 217 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 218 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst 219 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss 220 ENDIF 182 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst 183 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss 221 184 222 185 #if defined key_asminc … … 260 223 ! 261 224 END SUBROUTINE tra_sbc 262 225 263 226 264 227 SUBROUTINE tra_sbc_RK3 ( kt, Kmm, pts, Krhs, kstg )
Note: See TracChangeset
for help on using the changeset viewer.
