Changeset 4368 for LMDZ6/branches/Ocean_skin/libf/phylmd/traclmdz_mod.F90
- Timestamp:
- Dec 6, 2022, 12:01:16 AM (18 months ago)
- Location:
- LMDZ6/branches/Ocean_skin
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/traclmdz_mod.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Ocean_skin
- Property svn:mergeinfo changed
-
LMDZ6/branches/Ocean_skin/libf/phylmd/traclmdz_mod.F90
r3605 r4368 67 67 68 68 USE dimphy 69 USE infotrac_phy 69 USE infotrac_phy, ONLY: nbtr 70 70 71 71 ! Input argument … … 89 89 ! Initialization of the tracers should be done here only for those not found in the restart file. 90 90 USE dimphy 91 USE infotrac_phy 91 USE infotrac_phy, ONLY: nbtr, nqtot, tracers, pbl_flg, conv_flg 92 92 USE regr_pr_comb_coefoz_m, ONLY: alloc_coefoz 93 93 USE press_coefoz_m, ONLY: press_coefoz … … 96 96 USE indice_sol_mod 97 97 USE print_control_mod, ONLY: lunout 98 USE strings_mod, ONLY: strLower 98 99 99 100 ! Input variables … … 113 114 114 115 ! Local variables 115 INTEGER :: ierr, it, i iq, i, k116 INTEGER :: ierr, it, iq, i, k 116 117 REAL, DIMENSION(klon_glo,klev) :: varglo ! variable temporaire sur la grille global 117 118 REAL, DIMENSION(klev) :: mintmp, maxtmp … … 172 173 id_rn=0; id_pb=0; id_aga=0; id_be=0; id_o3=0 173 174 id_pcsat=0; id_pcocsat=0; id_pcq=0; id_pcs0=0; id_pcos0=0; id_pcq0=0 174 DO it=1,nbtr 175 !! iiq=niadv(it+2) ! jyg 176 iiq=niadv(it+nqo) ! jyg 177 IF ( tname(iiq) == "RN" ) THEN 178 id_rn=it ! radon 179 ELSE IF ( tname(iiq) == "PB") THEN 180 id_pb=it ! plomb 181 ! RomP >>> profil initial de PB210 182 open (ilesfil2,file='prof.pb210',status='old',iostat=irr2) 183 IF (irr2 == 0) THEN 184 read(ilesfil2,*) kradio2 185 print*,'number of levels for pb210 profile ',kradio2 186 do k=kradio2,1,-1 187 read (ilesfil2,*) plomb(:,k) 188 enddo 189 close(ilesfil2) 190 do k=1,klev 191 do i=1,klon 192 tr_seri(i,k,id_pb)=plomb(i,k) 193 !! print*, 'tr_seri',i,k,tr_seri(i,k,id_pb) 194 enddo 195 enddo 196 ELSE 197 print *, 'Prof.pb210 does not exist: use restart values' 198 ENDIF 199 ! RomP <<< 200 ELSE IF ( tname(iiq) == "Aga" .OR. tname(iiq) == "AGA" ) THEN 201 ! Age of stratospheric air 202 id_aga=it 203 radio(id_aga) = .FALSE. 204 aerosol(id_aga) = .FALSE. 205 pbl_flg(id_aga) = 0 206 207 ! Find the first model layer above 1.5km from the surface 208 IF (klev>=30) THEN 209 lev_1p5km=6 ! NB! This value is for klev=39 210 ELSE IF (klev>=10) THEN 211 lev_1p5km=5 ! NB! This value is for klev=19 212 ELSE 213 lev_1p5km=klev/2 214 END IF 215 ELSE IF ( tname(iiq) == "BE" .OR. tname(iiq) == "Be" .OR. & 216 tname(iiq) == "BE7" .OR. tname(iiq) == "Be7" ) THEN 217 ! Recherche du Beryllium 7 218 id_be=it 219 ALLOCATE( srcbe(klon,klev) ) 220 radio(id_be) = .TRUE. 221 aerosol(id_be) = .TRUE. ! le Be est un aerosol 222 !jyg le 13/03/2013 ; ajout de pplay en argument de init_be 223 !!! CALL init_be(pctsrf,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe) 224 CALL init_be(pctsrf,pplay,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe) 225 WRITE(lunout,*) 'Initialisation srcBe: OK' 226 ! RomP >>> profil initial de Be7 227 open (ilesfil,file='prof.be7',status='old',iostat=irr) 228 IF (irr == 0) THEN 229 read(ilesfil,*) kradio 230 print*,'number of levels for Be7 profile ',kradio 231 do k=kradio,1,-1 232 read (ilesfil,*) beryllium(:,k) 233 enddo 234 close(ilesfil) 235 do k=1,klev 236 do i=1,klon 237 tr_seri(i,k,id_be)=beryllium(i,k) 238 !! print*, 'tr_seri',i,k,tr_seri(i,k,id_be) 239 enddo 240 enddo 241 ELSE 242 print *, 'Prof.Be7 does not exist: use restart values' 243 ENDIF 244 ! RomP <<< 245 ELSE IF (tname(iiq)=="O3" .OR. tname(iiq)=="o3") THEN 246 ! Recherche de l'ozone : parametrization de la chimie par Cariolle 247 id_o3=it 248 CALL alloc_coefoz ! allocate ozone coefficients 249 CALL press_coefoz ! read input pressure levels 250 ELSE IF ( tname(iiq) == "pcsat" .OR. tname(iiq) == "Pcsat" ) THEN 251 id_pcsat=it 252 ELSE IF ( tname(iiq) == "pcocsat" .OR. tname(iiq) == "Pcocsat" ) THEN 253 id_pcocsat=it 254 ELSE IF ( tname(iiq) == "pcq" .OR. tname(iiq) == "Pcq" ) THEN 255 id_pcq=it 256 ELSE IF ( tname(iiq) == "pcs0" .OR. tname(iiq) == "Pcs0" ) THEN 257 id_pcs0=it 258 conv_flg(it)=0 ! No transport by convection for this tracer 259 ELSE IF ( tname(iiq) == "pcos0" .OR. tname(iiq) == "Pcos0" ) THEN 260 id_pcos0=it 261 conv_flg(it)=0 ! No transport by convection for this tracer 262 ELSE IF ( tname(iiq) == "pcq0" .OR. tname(iiq) == "Pcq0" ) THEN 263 id_pcq0=it 264 conv_flg(it)=0 ! No transport by convection for this tracer 265 ELSE 266 WRITE(lunout,*) 'This is an unknown tracer in LMDZ : ', trim(tname(iiq)) 267 END IF 175 it = 0 176 DO iq = 1, nqtot 177 IF(.NOT.(tracers(iq)%isInPhysics)) CYCLE 178 it = it+1 179 SELECT CASE(strLower(tracers(iq)%name)) 180 CASE("rn"); id_rn = it ! radon 181 CASE("pb"); id_pb = it ! plomb 182 CASE("aga"); id_aga = it ! Age of stratospheric air 183 CASE("be","be7");id_be = it ! Recherche du Beryllium 7 184 CASE("o3"); id_o3 = it ! Recherche de l'ozone 185 CASE("pcsat"); id_pcsat = it 186 CASE("pcocsat"); id_pcocsat= it 187 CASE("pcq"); id_pcq = it 188 CASE("pcs0"); id_pcs0 = it 189 CASE("pcos0"); id_pcos0 = it 190 CASE("pcq0"); id_pcq0 = it 191 CASE DEFAULT 192 WRITE(lunout,*) 'This is an unknown tracer in LMDZ : ', trim(tracers(iq)%name) 193 END SELECT 194 195 SELECT CASE(strLower(tracers(iq)%name)) 196 CASE("pb") !--- RomP >>> profil initial de PB210 197 OPEN(ilesfil2,file='prof.pb210',status='old',iostat=irr2) 198 IF(irr2 == 0) THEN 199 READ(ilesfil2,*) kradio2 200 WRITE(lunout,*)'number of levels for pb210 profile ',kradio2 201 DO k=kradio2,1,-1; READ (ilesfil2,*) plomb(:,k); END DO 202 CLOSE(ilesfil2) 203 tr_seri(:,:,id_pb) = plomb(:,:) 204 ELSE 205 WRITE(lunout,*)'Prof. Pb210 does not exist: use restart values' 206 END IF 207 CASE("aga") 208 radio(id_aga) = .FALSE. 209 aerosol(id_aga) = .FALSE. 210 pbl_flg(id_aga) = 0 211 ! Find the first model layer above 1.5km from the surface 212 IF (klev>=30) THEN 213 lev_1p5km=6 !--- NB: This value is for klev=39 214 ELSE IF (klev>=10) THEN 215 lev_1p5km=5 !--- NB: This value is for klev=19 216 ELSE 217 lev_1p5km=klev/2 218 END IF 219 CASE("be","be7") 220 ALLOCATE( srcbe(klon,klev) ) 221 radio(id_be) = .TRUE. 222 aerosol(id_be) = .TRUE. !--- Le Be est un aerosol 223 CALL init_be(pctsrf,pplay,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe) 224 WRITE(lunout,*) 'Initialisation srcBe: OK' 225 !--- RomP >>> profil initial de Be7 226 OPEN(ilesfil,file='prof.be7',status='old',iostat=irr) 227 IF(irr == 0) THEN 228 READ(ilesfil,*) kradio 229 WRITE(lunout,*)'number of levels for Be7 profile ',kradio 230 DO k=kradio,1,-1; READ(ilesfil,*) beryllium(:,k); END DO 231 CLOSE(ilesfil) 232 tr_seri(:,:,id_be)=beryllium(:,:) 233 ELSE 234 WRITE(lunout,*)'Prof. Be7 does not exist: use restart values' 235 END IF 236 CASE("o3") !--- Parametrisation par la chimie de Cariolle 237 CALL alloc_coefoz !--- Allocate ozone coefficients 238 CALL press_coefoz !--- Read input pressure levels 239 CASE("pcs0","pcos0","pcq0") 240 conv_flg(it)=0 !--- No transport by convection for this tracer 241 END SELECT 268 242 END DO 269 243 … … 286 260 ! Check if all tracers have restart values 287 261 ! ---------------------------------------------- 288 DO it=1,nbtr 289 !! iiq=niadv(it+2) ! jyg 290 iiq=niadv(it+nqo) ! jyg 262 it = 0 263 DO iq = 1, nqtot 264 IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE 265 it = it+1 291 266 ! Test if tracer is zero everywhere. 292 267 ! Done by master process MPI and master thread OpenMP … … 309 284 IF (zero) THEN 310 285 ! The tracer was not found in restart file or it was equal zero everywhere. 311 WRITE(lunout,*) "The tracer ",trim(t name(iiq))," will be initialized"286 WRITE(lunout,*) "The tracer ",trim(tracers(iq)%name)," will be initialized" 312 287 IF (it==id_pcsat .OR. it==id_pcq .OR. & 313 288 it==id_pcs0 .OR. it==id_pcq0) THEN … … 336 311 337 312 USE dimphy 338 USE infotrac_phy 313 USE infotrac_phy, ONLY: nbtr, pbl_flg 314 USE strings_mod, ONLY: int2str 339 315 USE regr_pr_comb_coefoz_m, ONLY: regr_pr_comb_coefoz 340 316 USE o3_chem_m, ONLY: o3_chem … … 576 552 577 553 DO it=1,nbtr 578 WRITE(solsym(it),'(i2)') it579 END DO580 581 DO it=1,nbtr582 554 IF(radio(it)) then 583 555 DO k = 1, klev … … 586 558 END DO 587 559 END DO 588 CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'puits rn it='// solsym(it))560 CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'puits rn it='//TRIM(int2str(it))) 589 561 END IF 590 562 END DO … … 611 583 ! variable trs is written to restart file (restartphy.nc) 612 584 USE dimphy 613 USE infotrac_phy 585 USE infotrac_phy, ONLY: nbtr 614 586 615 587 REAL,DIMENSION(klon,nbtr), INTENT(OUT) :: trs_out
Note: See TracChangeset
for help on using the changeset viewer.
