Changeset 5116 for LMDZ6/branches/Amaury_dev/libf/phylmd/Dust
- Timestamp:
- Jul 24, 2024, 2:54:37 PM (6 months ago)
- Location:
- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust
- Files:
-
- 16 edited
-
coarsemission.f90 (modified) (4 diffs)
-
condsurfc.f90 (modified) (1 diff)
-
condsurfc_new.f90 (modified) (1 diff)
-
condsurfs.f90 (modified) (1 diff)
-
condsurfs_new.f90 (modified) (3 diffs)
-
dustemission_mod.F90 (modified) (25 diffs)
-
lsc_scav_orig.F90 (modified) (7 diffs)
-
lsc_scav_spl.F90 (modified) (7 diffs)
-
minmaxqfi2.f90 (modified) (2 diffs)
-
minmaxsource.f90 (modified) (2 diffs)
-
neutral.f90 (modified) (5 diffs)
-
phys_output_write_spl_mod.F90 (modified) (1 diff)
-
phytracr_spl_mod.F90 (modified) (25 diffs)
-
read_dust.f90 (modified) (1 diff)
-
read_surface.F90 (modified) (3 diffs)
-
read_vent.f90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/coarsemission.f90
r5104 r5116 94 94 REAL :: dust_ec(klon) 95 95 96 real:: tmp_var2(klon, nbtr) ! auxiliary variable to replace source96 REAL :: tmp_var2(klon, nbtr) ! auxiliary variable to replace source 97 97 REAL :: qmin, qmax 98 98 !----------------------DUST Sahara --------------- … … 195 195 196 196 DO i = 1, klon 197 if (maskd(i)>0) then197 if (maskd(i)>0) THEN 198 198 IF(id_fine>0) source_tr(i, id_fine) = & 199 199 scale_param_dustacc(iregion_dust(i)) * & … … 266 266 ENDDO 267 267 CALL minmaxsource(tmp_var2, qmin, qmax, 'src: before SS emiss') 268 IF(id_coss>0) then268 IF(id_coss>0) THEN 269 269 print *, 'Source = ', SUM(source_tr(:, id_coss)), & 270 270 MINVAL(source_tr(:, id_coss)), MAXVAL(source_tr(:, id_coss)) … … 299 299 ENDDO 300 300 CALL minmaxsource(tmp_var2, qmin, qmax, 'src: after SS emiss') 301 IF(id_coss>0) then301 IF(id_coss>0) THEN 302 302 print *, 'Source = ', SUM(source_tr(:, id_coss)), & 303 303 MINVAL(source_tr(:, id_coss)), MAXVAL(source_tr(:, id_coss)) -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc.f90
r5105 r5116 35 35 36 36 ierr = nf90_open ("limitcarbon.nc", nf90_nowrite, nid1) 37 if (ierr/=nf90_noerr) then38 write(6, *)' Pb d''ouverture du fichier limitbc.nc'39 write(6, *)' ierr = ', ierr37 if (ierr/=nf90_noerr) THEN 38 WRITE(6, *)' Pb d''ouverture du fichier limitbc.nc' 39 WRITE(6, *)' ierr = ', ierr 40 40 CALL exit(1) 41 41 endif -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc_new.f90
r5113 r5116 58 58 59 59 ierr = nf90_open ("carbon_emissions.nc", nf90_nowrite, nid1) 60 if (ierr/=nf90_noerr) then61 write(6, *)' Pb d''ouverture du fichier limitbc.nc'62 write(6, *)' ierr = ', ierr60 if (ierr/=nf90_noerr) THEN 61 WRITE(6, *)' Pb d''ouverture du fichier limitbc.nc' 62 WRITE(6, *)' ierr = ', ierr 63 63 CALL exit(1) 64 64 endif -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs.f90
r5105 r5116 36 36 37 37 ierr = nf90_open ("limitsoufre.nc", nf90_nowrite, nid) 38 if (ierr/=nf90_noerr) then39 write(6, *)' Pb d''ouverture du fichier limitsoufre.nc'40 write(6, *)' ierr = ', ierr38 if (ierr/=nf90_noerr) THEN 39 WRITE(6, *)' Pb d''ouverture du fichier limitsoufre.nc' 40 WRITE(6, *)' ierr = ', ierr 41 41 CALL exit(1) 42 42 endif -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs_new.f90
r5110 r5116 61 61 62 62 ierr = nf90_open ("sulphur_emissions_antro.nc", nf90_nowrite, nid) 63 if (ierr/=nf90_noerr) then64 write(6, *)' Pb d''ouverture du fichier sulphur_emissions_antro'65 write(6, *)' ierr = ', ierr63 if (ierr/=nf90_noerr) THEN 64 WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_antro' 65 WRITE(6, *)' ierr = ', ierr 66 66 CALL exit(1) 67 67 endif … … 130 130 !======================================================================= 131 131 ierr = nf90_open ("sulphur_emissions_nat.nc", nf90_nowrite, nid) 132 if (ierr/=nf90_noerr) then133 write(6, *)' Pb d''ouverture du fichier sulphur_emissions_nat'134 write(6, *)' ierr = ', ierr132 if (ierr/=nf90_noerr) THEN 133 WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_nat' 134 WRITE(6, *)' ierr = ', ierr 135 135 CALL exit(1) 136 136 endif … … 185 185 print *, ' Jour = ', jour 186 186 ierr = nf90_open ("sulphur_emissions_volc.nc", nf90_nowrite, nid) 187 if (ierr/=nf90_noerr) then188 write(6, *)' Pb d''ouverture du fichier sulphur_emissions_volc'189 write(6, *)' ierr = ', ierr187 if (ierr/=nf90_noerr) THEN 188 WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_volc' 189 WRITE(6, *)' ierr = ', ierr 190 190 CALL exit(1) 191 191 endif -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90
r5113 r5116 253 253 INTEGER,DIMENSION(klon) :: maskdustloc 254 254 INTEGER :: i,j,k 255 integer:: iaux255 INTEGER :: iaux 256 256 257 257 … … 259 259 maskdustloc(k)=0 260 260 do i=1,ntyp 261 if (masklisa(k,i)>0) then261 if (masklisa(k,i)>0) THEN 262 262 maskdustloc(k)=1 263 263 endif … … 332 332 333 333 logical :: debutphy 334 real:: diff, auxr1,auxr2,auxr3,auxr4334 REAL :: diff, auxr1,auxr2,auxr3,auxr4 335 335 real,dimension(klon,nbins) :: itvmean 336 336 real,dimension(klon,nbins+1) :: itv2 … … 346 346 347 347 writeaerosoldistrib=.FALSE. 348 IF (debutphy) then 349 350 if (sizedustmin>sizeacclow .or. sizedustmax<sizescohigh) then 348 IF (debutphy) THEN 349 if (sizedustmin>sizeacclow .or. sizedustmax<sizescohigh) THEN 351 350 CALL abort_gcm('adaptdustemission', 'Dust range problem',1) 352 351 endif … … 360 359 auxr4=9999. 361 360 do i=1,nbins+1 362 if (abs(sizeacclow-itv(i))<auxr1) then361 if (abs(sizeacclow-itv(i))<auxr1) THEN 363 362 auxr1=abs( sizeacclow-itv(i)) 364 363 iminacclow=i 365 364 endif 366 if (abs(sizeacchigh-itv(i))<auxr2) then365 if (abs(sizeacchigh-itv(i))<auxr2) THEN 367 366 auxr2=abs( sizeacchigh-itv(i)) 368 367 iminacchigh=i 369 368 imincoalow=i 370 369 endif 371 if (abs(sizecoahigh-itv(i))<auxr3) then370 if (abs(sizecoahigh-itv(i))<auxr3) THEN 372 371 auxr3=abs( sizecoahigh-itv(i)) 373 372 imincoahigh=i 374 373 iminscolow=i 375 374 endif 376 if (abs(sizescohigh-itv(i))<auxr4) then375 if (abs(sizescohigh-itv(i))<auxr4) THEN 377 376 auxr4=abs( sizescohigh-itv(i)) 378 377 iminscohigh=i 379 378 endif 380 379 enddo 381 IF (writeaerosoldistrib) then380 IF (writeaerosoldistrib) THEN 382 381 !JEdbg<< 383 382 do j=1,klon … … 468 467 469 468 !JEdbg<< 470 IF (writeaerosoldistrib) then469 IF (writeaerosoldistrib) THEN 471 470 do i=1,nbins 472 471 do j=1,klon … … 700 699 701 700 ! print *,'JEOK2',mpi_rank,omp_rank 702 IF ( 1==1 ) then 703 701 IF ( 1==1 ) THEN 704 702 ! print *,'JEOK4',mpi_rank,omp_rank 705 703 CALL writefield_phy("SOL",sol,5) … … 756 754 dp=dp*exp(dstep) 757 755 sizeclass(i)=dp 758 if(dp>=dmax+eps)goto 30756 IF(dp>=dmax+eps)goto 30 759 757 newstep(i)=dstep 760 758 ! WRITE(18,*)i,sizeclass(i) … … 765 763 PRINT*,' soil size classes used ',ncl,' / ',nclass 766 764 PRINT*,' soil size min: ',sizeclass(1),' soil size max: ',sizeclass(ncl) 767 if(ncl>nclass)stop765 IF(ncl>nclass)stop 768 766 769 767 ! Threshold velocity: 770 IF (.FALSE.) then771 !if (.TRUE.) then768 IF (.FALSE.) THEN 769 !if (.TRUE.) THEN 772 770 !c 0: Iversen and White 1982 773 771 print *,'Using Iversen and White 1982 Uth' … … 776 774 cc=sqrt(1+ddust*(sizeclass(i)**(-2.5))) 777 775 xk=sqrt(abs(rop*gravity*sizeclass(i)/roa)) 778 if (bb<10.) then776 if (bb<10.) THEN 779 777 dd=sqrt(1.928*(bb**0.092)-1.) 780 778 uth(i)=0.129*xk*cc/dd … … 786 784 enddo 787 785 END IF 788 IF(.TRUE.) then786 IF(.TRUE.) THEN 789 787 ! 1: Shao and Lu 2000 790 788 print *,'Using Shao and Lu 2000 Uth' … … 850 848 do k=1,ntyp 851 849 ! PRINT*,'IKKK ',i,klon,k,ntyp 852 if (zos(i,k)==0..or.z01(i,k)==0.) then853 ! if (zos(i,k)<=0..or.z01(i,k)<=0.) then854 ! if (zos(i,k)<0..or.z01(i,k)<0.) then850 if (zos(i,k)==0..or.z01(i,k)==0.) THEN 851 ! if (zos(i,k)<=0..or.z01(i,k)<=0.) THEN 852 ! if (zos(i,k)<0..or.z01(i,k)<0.) THEN 855 853 ! PRINT*,'INI DUST WARNING zos ou z01<0',zos(i,k),z01(i,k) 856 854 ! endif … … 869 867 ! drag partition between zo1 and zo2 870 868 ! feff: total efficient fraction 871 if(D(i,k)==0.)then869 IF(D(i,k)==0.)THEN 872 870 feff(i,k)=cc 873 871 ! PRINT*,'IKKK C ',i,klon,k,ntyp … … 887 885 enddo 888 886 ! JE20150120<< 889 if (flag_feff == 0) then887 if (flag_feff == 0) THEN 890 888 print *,'JE_dbg FORCED deactivated feff' 891 889 do i=1,klon … … 898 896 899 897 900 IF (1==1) then898 IF (1==1) THEN 901 899 ! ! CALL writefield_phy("AA",tmp1(1:klon,1:5),5) 902 900 … … 919 917 920 918 921 ! if (.FALSE.) then919 ! if (.FALSE.) THEN 922 920 !!**************L718 923 921 … … 1083 1081 DO k=1,ndistb 1084 1082 DO nb=1,nbins 1085 write(15001,*) k,nb,massfrac(k,nb)1083 WRITE(15001,*) k,nb,massfrac(k,nb) 1086 1084 ENDDO 1087 1085 ENDDO … … 1242 1240 1243 1241 !IF(n.eq.1.and.nat.eq.99)GOTO 80 1244 ! if(n.eq.1) PRINT*,'nat1=',nat,'sol1=',sol(i,n)1242 ! IF(n.eq.1) PRINT*,'nat1=',nat,'sol1=',sol(i,n) 1245 1243 IF(n==1.and.nat==99)GOTO 80 1246 1244 … … 1248 1246 IF(.TRUE.) THEN 1249 1247 nat=int(sol(i,n)) 1250 if(n == 1 .and. nat >= 14 .or. nat < 1 .or. nat > 19) GOTO 801248 IF(n == 1 .and. nat >= 14 .or. nat < 1 .or. nat > 19) GOTO 80 1251 1249 ENDIF 1252 1250 !JE20150129>>>> … … 1277 1275 do ni=1,kfin 1278 1276 fdp1=1.-(uth2(ni)/(ceff*ustarsalt)) 1279 if (fdp1<=0..or.srel2(nat,ni)==0.) then1277 if (fdp1<=0..or.srel2(nat,ni)==0.) THEN 1280 1278 ad1=0. 1281 1279 ad2=0. … … 1293 1291 t2=0. 1294 1292 t3=0. 1295 if(ec>=e1)t1=1.1296 if(ec>=e2)t2=1.1297 if(ec>=e3)t3=1.1298 if(dfec3/=0.)then1293 IF(ec>=e1)t1=1. 1294 IF(ec>=e2)t2=1. 1295 IF(ec>=e3)t3=1. 1296 IF(dfec3/=0.)THEN 1299 1297 p1=t1*dfec1/dfec3 1300 1298 p2=t2*(1.-p1)*dfec2/dfec3 … … 1405 1403 srel2(nat,kfin)=srel(nat,i)*istep 1406 1404 enddo 1407 if(kfin>=nclass)then1405 IF(kfin>=nclass)THEN 1408 1406 PRINT*,'$$$$ Tables dimension problem:',kfin,'>',nclass 1409 1407 endif … … 1436 1434 ihalf=int((ismax+ismin)/2.) 1437 1435 do k2=1,1000000 1438 if(ds>siz(ihalf))then1436 IF(ds>siz(ihalf))THEN 1439 1437 ismin=ihalf 1440 1438 else … … 1443 1441 ihalf=int((ismax+ismin)/2.) 1444 1442 idiff=ismax-ismin 1445 if(idiff<=1)then1443 IF(idiff<=1)THEN 1446 1444 iout=ismin 1447 1445 goto 52 … … 1449 1447 enddo 1450 1448 52 continue 1451 if(iout==0)then1449 IF(iout==0)THEN 1452 1450 PRINT*,'$$$$ Tables dimension problem: ',iout 1453 1451 endif -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_orig.F90
r5110 r5116 87 87 !$OMP THREADPRIVATE(alpha_r, alpha_s, R_r, R_s) 88 88 REAL :: pr, ps, ice, water 89 real:: conserv89 REAL :: conserv 90 90 91 91 !!!!!!!!!!!!!!!!!!!! choix lessivage !!!!!!!!!!!!!!!!!!!!!!!! … … 98 98 ! inscav_fisrt=.TRUE. 99 99 ! CALL getin('inscav_fisrt',inscav_fisrt) 100 ! if(inscav_fisrt) then100 ! IF(inscav_fisrt) THEN 101 101 ! PRINT*,'beta from fisrtilp.F90, beta = (z_cond - z_oliq)/z_cond, inscav_fisrt=',inscav_fisrt 102 102 ! else … … 200 200 DO i=1, klon 201 201 ! incloud scavenging 202 ! if(inscav_fisrt) then203 if (iflag_lscav == 4) then202 ! IF(inscav_fisrt) THEN 203 if (iflag_lscav == 4) THEN 204 204 beta=beta_fisrt(i,k)*rneb(i,k) 205 205 else … … 217 217 218 218 ! below-cloud impaction 219 IF(it==1) then219 IF(it==1) THEN 220 220 d_tr_bcscav(i,k,it)=0. 221 221 ELSE … … 234 234 deltaP(i,k)=max(deltaP(i,k),0.) 235 235 236 if(flxr(i,k+1)+flxs(i,k+1)>1.e-16) then236 IF(flxr(i,k+1)+flxs(i,k+1)>1.e-16) THEN 237 237 beta_ev(i,k)=deltaP(i,k)/(flxr(i,k+1)+flxs(i,k+1)) 238 238 else … … 244 244 !jyg 245 245 246 if(abs(1-(1-frac_ev)*beta_ev(i,k))>1.e-16) then246 IF(abs(1-(1-frac_ev)*beta_ev(i,k))>1.e-16) THEN 247 247 ! remove tracers from precipitation owing to release by evaporation in his_dh 248 248 ! dxev=frac_ev*beta_ev(i,k)*his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k)) & … … 282 282 ! +d_tr_bcscav(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG & 283 283 ! +d_tr_evap(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG 284 ! if(it.eq.3) write(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),&284 ! IF(it.eq.3) WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),& 285 285 ! k,'lsc conserv ',conserv,'insc',d_tr_insc(i,k,it),'bc',d_tr_bcscav(i,k,it),'ev',d_tr_evap(i,k,it) 286 286 ! ENDDO -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_spl.F90
r5110 r5116 97 97 !$OMP THREADPRIVATE(R_r, R_s) 98 98 REAL :: pr, ps, ice, water 99 real:: conserv99 REAL :: conserv 100 100 101 101 !!!!!!!!!!!!!!!!!!!! choix lessivage !!!!!!!!!!!!!!!!!!!!!!!! … … 108 108 ! inscav_fisrt=.TRUE. 109 109 ! CALL getin('inscav_fisrt',inscav_fisrt) 110 ! if(inscav_fisrt) then110 ! IF(inscav_fisrt) THEN 111 111 ! PRINT*,'beta from fisrtilp.F90, beta = (z_cond - z_oliq)/z_cond, inscav_fisrt=',inscav_fisrt 112 112 ! else … … 211 211 DO i=1, klon 212 212 ! incloud scavenging 213 ! if(inscav_fisrt) then214 if (iflag_lscav == 4) then213 ! IF(inscav_fisrt) THEN 214 if (iflag_lscav == 4) THEN 215 215 beta=beta_fisrt(i,k)*rneb(i,k) 216 216 else … … 228 228 229 229 ! below-cloud impaction 230 IF(it==id_prec) then230 IF(it==id_prec) THEN 231 231 d_tr_bcscav(i,k,it)=0. 232 232 ELSE … … 245 245 deltaP(i,k)=max(deltaP(i,k),0.) 246 246 247 if(flxr(i,k+1)+flxs(i,k+1)>1.e-16) then247 IF(flxr(i,k+1)+flxs(i,k+1)>1.e-16) THEN 248 248 beta_ev(i,k)=deltaP(i,k)/(flxr(i,k+1)+flxs(i,k+1)) 249 249 else … … 255 255 !jyg 256 256 257 if(abs(1-(1-frac_ev)*beta_ev(i,k))>1.e-16) then257 IF(abs(1-(1-frac_ev)*beta_ev(i,k))>1.e-16) THEN 258 258 ! remove tracers from precipitation owing to release by evaporation in his_dh 259 259 ! dxev=frac_ev*beta_ev(i,k)*his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k)) & … … 293 293 ! +d_tr_bcscav(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG & 294 294 ! +d_tr_evap(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG 295 ! if(it.eq.3) write(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),&295 ! IF(it.eq.3) WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),& 296 296 ! k,'lsc conserv ',conserv,'insc',d_tr_insc(i,k,it),'bc',d_tr_bcscav(i,k,it),'ev',d_tr_evap(i,k,it) 297 297 ! ENDDO -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxqfi2.f90
r5104 r5116 3 3 USE dimphy 4 4 USE infotrac 5 USE lmdz_libmath, ONLY: ismax, ismin 5 6 INCLUDE "dimensions.h" 6 7 7 8 ! character*20 comment 8 character(len= *) :: comment9 real:: qmin, qmax10 real:: zq(klon, klev)9 CHARACTER(LEN = *) :: comment 10 REAL :: qmin, qmax 11 REAL :: zq(klon, klev) 11 12 12 integer :: ijmin, lmin, ijlmin 13 integer :: ijmax, lmax, ijlmax 14 15 integer :: ismin, ismax 13 INTEGER :: ijmin, lmin, ijlmin 14 INTEGER :: ijmax, lmax, ijlmax 16 15 17 16 ijlmin = ismin(klon * klev, zq, 1) … … 25 24 zqmax = zq(ijmax, lmax) 26 25 27 if(zqmin<qmin.or.zqmax>qmax) &28 write(*, 9999) comment, &26 IF(zqmin<qmin.or.zqmax>qmax) & 27 WRITE(*, 9999) comment, & 29 28 ijmin, lmin, zqmin, ijmax, lmax, zqmax 30 29 31 return30 RETURN 32 31 9999 format(a20, 2(' q(', i4, ',', i2, ')=', e12.5)) 33 end subroutineminmaxqfi232 END SUBROUTINE minmaxqfi2 -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxsource.f90
r5104 r5116 3 3 USE dimphy 4 4 USE infotrac 5 USE lmdz_libmath, ONLY: ismax, ismin 5 6 6 7 INCLUDE "dimensions.h" 7 8 8 9 ! character*20 comment 9 character(len= *) :: comment10 real:: qmin, qmax11 real:: zq(klon, nbtr)10 CHARACTER(LEN = *) :: comment 11 REAL :: qmin, qmax 12 REAL :: zq(klon, nbtr) 12 13 13 integer :: ijmin, lmin, ijlmin 14 integer :: ijmax, lmax, ijlmax 15 16 integer :: ismin, ismax 14 INTEGER :: ijmin, lmin, ijlmin 15 INTEGER :: ijmax, lmax, ijlmax 17 16 18 17 ijlmin = ismin(klon * nbtr, zq, 1) … … 26 25 zqmax = zq(ijmax, lmax) 27 26 28 if(zqmin<qmin.or.zqmax>qmax) &29 write(*, 9999) comment, &27 IF(zqmin<qmin.or.zqmax>qmax) & 28 WRITE(*, 9999) comment, & 30 29 ijmin, lmin, zqmin, ijmax, lmax, zqmax 31 30 32 return31 RETURN 33 32 9999 format(a20, 2(' q(', i4, ',', i2, ')=', e12.5)) 34 end subroutineminmaxsource33 END SUBROUTINE minmaxsource -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/neutral.f90
r5105 r5116 30 30 INCLUDE "dimensions.h" 31 31 ! 32 real:: u10_mps(klon), ustar_mps(klon), obklen_m(klon)33 real:: u10n_mps(klon)34 real:: pi, von_karman32 REAL :: u10_mps(klon), ustar_mps(klon), obklen_m(klon) 33 REAL :: u10n_mps(klon) 34 REAL :: pi, von_karman 35 35 ! parameter (pi = 3.141592653589793, von_karman = 0.4) 36 36 ! pour etre coherent avec vk de bl_for_dms.F 37 37 parameter (pi = 3.141592653589793, von_karman = 0.35) 38 38 ! 39 real:: phi, phi_inv, phi_inv_sq, f1, f2, f3, dum1, psi40 integer:: i39 REAL :: phi, phi_inv, phi_inv_sq, f1, f2, f3, dum1, psi 40 INTEGER :: i 41 41 42 42 psi = 0. … … 45 45 if (u10_mps(i) < 0.) u10_mps(i) = 0.0 46 46 47 if (obklen_m(i) < 0.) then47 if (obklen_m(i) < 0.) THEN 48 48 phi = (1. - 160. / obklen_m(i))**(-0.25) 49 49 phi_inv = 1. / phi … … 55 55 f3 = atan(dum1) 56 56 psi = 2. * log(f1) + log(f2) - 2. * f3 + pi / 2. 57 else if (obklen_m(i) > 0.) then57 else if (obklen_m(i) > 0.) THEN 58 58 psi = -50. / obklen_m(i) 59 59 end if … … 61 61 u10n_mps(i) = u10_mps(i) + (ustar_mps(i) * psi / von_karman) 62 62 ! u10n set to 0. if -1 < obklen < 20 63 if ((obklen_m(i)>-1.).and.(obklen_m(i)<20.)) then63 if ((obklen_m(i)>-1.).and.(obklen_m(i)<20.)) THEN 64 64 u10n_mps(i) = 0. 65 65 endif … … 68 68 enddo 69 69 70 end subroutineneutral70 END SUBROUTINE neutral 71 71 !*********************************************************************** -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phys_output_write_spl_mod.F90
r5112 r5116 466 466 IF (vars_defined) THEN 467 467 IF (prt_level >= 10) THEN 468 write(lunout,*)"phys_output_write: CALL xios_update_calendar, itau_w=",itau_w468 WRITE(lunout,*)"phys_output_write: CALL xios_update_calendar, itau_w=",itau_w 469 469 ENDIF 470 470 ! CALL xios_update_calendar(itau_w) -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90
r5112 r5116 1213 1213 source_tr = 0. 1214 1214 1215 if (debutphy) then1215 if (debutphy) THEN 1216 1216 #ifdef IOPHYS_DUST 1217 1217 CALL iophys_ini(pdtphys) … … 1230 1230 IF(.NOT.tracers(iq)%isInPhysics) CYCLE 1231 1231 itr = itr+1 1232 write(str2,'(i2.2)') itrr1232 WRITE(str2,'(i2.2)') itrr 1233 1233 CALL iophys_ecrit('TRA'//str2,klev,'SOURCE','',tr_seri(:,:,itr)) 1234 1234 enddo … … 1394 1394 enddo 1395 1395 ! check consistency with dust emission scheme: 1396 if (ok_chimeredust) then1397 if (.not.(id_scdu>0 .and. id_codu>0 .and. id_fine>0)) then1396 if (ok_chimeredust) THEN 1397 if (.not.(id_scdu>0 .and. id_codu>0 .and. id_fine>0)) THEN 1398 1398 CALL abort_gcm('phytracr_mod', 'pb in ok_chimdust 0', 1) 1399 1399 endif 1400 1400 else 1401 if (id_scdu>0) then1401 if (id_scdu>0) THEN 1402 1402 CALL abort_gcm('phytracr_mod', 'pb in ok_chimdust 1 SCDU', 1) 1403 1403 endif 1404 if ((id_codu <= 0) .or. (id_fine<=0)) then1404 if ((id_codu <= 0) .or. (id_fine<=0)) THEN 1405 1405 CALL abort_gcm('phytracr_mod', 'pb in ok_chimdust 1', 1) 1406 1406 endif … … 1418 1418 !---fraction of tracer that is convected (Tiedke) 1419 1419 xconv(:) = 0. 1420 if(id_prec>0) xconv(id_prec) = 0.81421 if(id_fine>0) xconv(id_fine) = 0.51422 if(id_coss>0) xconv(id_coss) = 0.51423 if(id_codu>0) xconv(id_codu) = 0.61424 if(id_scdu>0) xconv(id_scdu) = 0.6 !!JE fix1420 IF(id_prec>0) xconv(id_prec) = 0.8 1421 IF(id_fine>0) xconv(id_fine) = 0.5 1422 IF(id_coss>0) xconv(id_coss) = 0.5 1423 IF(id_codu>0) xconv(id_codu) = 0.6 1424 IF(id_scdu>0) xconv(id_scdu) = 0.6 !!JE fix 1425 1425 1426 1426 masse(:) = 1. 1427 if(id_prec>0) masse(id_prec) = 32.1428 if(id_fine>0) masse(id_fine) = 6.02e231429 if(id_coss>0) masse(id_coss) = 6.02e231430 if(id_codu>0) masse(id_codu) = 6.02e231431 if(id_scdu>0) masse(id_scdu) = 6.02e231427 IF(id_prec>0) masse(id_prec) = 32. 1428 IF(id_fine>0) masse(id_fine) = 6.02e23 1429 IF(id_coss>0) masse(id_coss) = 6.02e23 1430 IF(id_codu>0) masse(id_codu) = 6.02e23 1431 IF(id_scdu>0) masse(id_scdu) = 6.02e23 1432 1432 1433 1433 henry(:) = 0. 1434 if(id_prec>0) henry(id_prec) = 1.41435 if(id_fine>0) henry(id_fine) = 0.01436 if(id_coss>0) henry(id_coss) = 0.01437 if(id_codu>0) henry(id_codu) = 0.01438 if(id_scdu>0) henry(id_scdu) = 0.01434 IF(id_prec>0) henry(id_prec) = 1.4 1435 IF(id_fine>0) henry(id_fine) = 0.0 1436 IF(id_coss>0) henry(id_coss) = 0.0 1437 IF(id_codu>0) henry(id_codu) = 0.0 1438 IF(id_scdu>0) henry(id_scdu) = 0.0 1439 1439 !henry= (/1.4, 0.0, 0.0, 0.0/) 1440 1440 kk(:) = 0. 1441 if(id_prec>0) kk(id_prec) = 2900.1442 if(id_fine>0) kk(id_fine) = 0.01443 if(id_coss>0) kk(id_coss) = 0.01444 if(id_codu>0) kk(id_codu) = 0.01445 if(id_scdu>0) kk(id_scdu) = 0.01441 IF(id_prec>0) kk(id_prec) = 2900. 1442 IF(id_fine>0) kk(id_fine) = 0.0 1443 IF(id_coss>0) kk(id_coss) = 0.0 1444 IF(id_codu>0) kk(id_codu) = 0.0 1445 IF(id_scdu>0) kk(id_scdu) = 0.0 1446 1446 !kk = (/2900., 0., 0., 0./) 1447 1447 alpha_r(:) = 0. 1448 if(id_prec>0) alpha_r(id_prec) = 0.01449 if(id_fine>0) alpha_r(id_fine) = 0.0011450 if(id_coss>0) alpha_r(id_coss) = 0.0011451 if(id_codu>0) alpha_r(id_codu) = 0.0011452 if(id_scdu>0) alpha_r(id_scdu) = 0.001 !JE fix1448 IF(id_prec>0) alpha_r(id_prec) = 0.0 1449 IF(id_fine>0) alpha_r(id_fine) = 0.001 1450 IF(id_coss>0) alpha_r(id_coss) = 0.001 1451 IF(id_codu>0) alpha_r(id_codu) = 0.001 1452 IF(id_scdu>0) alpha_r(id_scdu) = 0.001 !JE fix 1453 1453 alpha_s(:) = 0. 1454 if(id_prec>0) alpha_s(id_prec) = 0.01455 if(id_fine>0) alpha_s(id_fine) = 0.011456 if(id_coss>0) alpha_s(id_coss) = 0.011457 if(id_codu>0) alpha_s(id_codu) = 0.011458 if(id_scdu>0) alpha_s(id_scdu) = 0.01 !JE fix1454 IF(id_prec>0) alpha_s(id_prec) = 0.0 1455 IF(id_fine>0) alpha_s(id_fine) = 0.01 1456 IF(id_coss>0) alpha_s(id_coss) = 0.01 1457 IF(id_codu>0) alpha_s(id_codu) = 0.01 1458 IF(id_scdu>0) alpha_s(id_scdu) = 0.01 !JE fix 1459 1459 1460 1460 ! alpha_r = (/0., 0.001, 0.001, 0.001/) … … 1465 1465 !vdep_oce = (/0.28, 0.28, 1.2, 1.2/) 1466 1466 vdep_oce(:) = 0. 1467 if(id_prec>0) vdep_oce(id_prec) = 0.281468 if(id_fine>0) vdep_oce(id_fine) = 0.281469 if(id_coss>0) vdep_oce(id_coss) = 1.21470 if(id_codu>0) vdep_oce(id_codu) = 1.21471 if(id_scdu>0) vdep_oce(id_scdu) = 1.21467 IF(id_prec>0) vdep_oce(id_prec) = 0.28 1468 IF(id_fine>0) vdep_oce(id_fine) = 0.28 1469 IF(id_coss>0) vdep_oce(id_coss) = 1.2 1470 IF(id_codu>0) vdep_oce(id_codu) = 1.2 1471 IF(id_scdu>0) vdep_oce(id_scdu) = 1.2 1472 1472 vdep_sic(:) = 0. 1473 if(id_prec>0) vdep_sic(id_prec) = 0.21474 if(id_fine>0) vdep_sic(id_fine) = 0.171475 if(id_coss>0) vdep_sic(id_coss) = 1.21476 if(id_codu>0) vdep_sic(id_codu) = 1.21477 if(id_scdu>0) vdep_sic(id_scdu) = 1.21473 IF(id_prec>0) vdep_sic(id_prec) = 0.2 1474 IF(id_fine>0) vdep_sic(id_fine) = 0.17 1475 IF(id_coss>0) vdep_sic(id_coss) = 1.2 1476 IF(id_codu>0) vdep_sic(id_codu) = 1.2 1477 IF(id_scdu>0) vdep_sic(id_scdu) = 1.2 1478 1478 1479 1479 !vdep_sic = (/0.2, 0.17, 1.2, 1.2/) 1480 1480 !vdep_ter = (/0.3, 0.14, 1.2, 1.2/) 1481 1481 vdep_ter(:) = 0. 1482 if(id_prec>0) vdep_ter(id_prec) = 0.31483 if(id_fine>0) vdep_ter(id_fine) = 0.141484 if(id_coss>0) vdep_ter(id_coss) = 1.21485 if(id_codu>0) vdep_ter(id_codu) = 1.21486 if(id_scdu>0) vdep_ter(id_scdu) = 1.21482 IF(id_prec>0) vdep_ter(id_prec) = 0.3 1483 IF(id_fine>0) vdep_ter(id_fine) = 0.14 1484 IF(id_coss>0) vdep_ter(id_coss) = 1.2 1485 IF(id_codu>0) vdep_ter(id_codu) = 1.2 1486 IF(id_scdu>0) vdep_ter(id_scdu) = 1.2 1487 1487 1488 1488 vdep_lic(:) = 0. 1489 if(id_prec>0) vdep_lic(id_prec) = 0.21490 if(id_fine>0) vdep_lic(id_fine) = 0.171491 if(id_coss>0) vdep_lic(id_coss) = 1.21492 if(id_codu>0) vdep_lic(id_codu) = 1.21493 if(id_scdu>0) vdep_lic(id_scdu) = 1.21489 IF(id_prec>0) vdep_lic(id_prec) = 0.2 1490 IF(id_fine>0) vdep_lic(id_fine) = 0.17 1491 IF(id_coss>0) vdep_lic(id_coss) = 1.2 1492 IF(id_codu>0) vdep_lic(id_codu) = 1.2 1493 IF(id_scdu>0) vdep_lic(id_scdu) = 1.2 1494 1494 1495 1495 … … 1498 1498 ! mais effet negligeable sur l'AOD 1499 1499 ccntrAA_spla(:) = 0. 1500 if(id_prec>0) ccntrAA_spla(id_prec) = -9999.1501 if(id_fine>0) ccntrAA_spla(id_fine) = 0.71502 if(id_coss>0) ccntrAA_spla(id_coss) = 1.01503 if(id_codu>0) ccntrAA_spla(id_codu) = 0.71504 if(id_scdu>0) ccntrAA_spla(id_scdu) = 0.71500 IF(id_prec>0) ccntrAA_spla(id_prec) = -9999. 1501 IF(id_fine>0) ccntrAA_spla(id_fine) = 0.7 1502 IF(id_coss>0) ccntrAA_spla(id_coss) = 1.0 1503 IF(id_codu>0) ccntrAA_spla(id_codu) = 0.7 1504 IF(id_scdu>0) ccntrAA_spla(id_scdu) = 0.7 1505 1505 1506 1506 ccntrENV_spla(:) = 0. 1507 if(id_prec>0) ccntrENV_spla(id_prec) = -9999.1508 if(id_fine>0) ccntrENV_spla(id_fine) = 0.71509 if(id_coss>0) ccntrENV_spla(id_coss) = 1.01510 if(id_codu>0) ccntrENV_spla(id_codu) = 0.71511 if(id_scdu>0) ccntrENV_spla(id_scdu) = 0.71507 IF(id_prec>0) ccntrENV_spla(id_prec) = -9999. 1508 IF(id_fine>0) ccntrENV_spla(id_fine) = 0.7 1509 IF(id_coss>0) ccntrENV_spla(id_coss) = 1.0 1510 IF(id_codu>0) ccntrENV_spla(id_codu) = 0.7 1511 IF(id_scdu>0) ccntrENV_spla(id_scdu) = 0.7 1512 1512 ! #DFB 1513 1513 coefcoli_spla(:) = 0. 1514 if(id_prec>0) coefcoli_spla(id_prec) = -9999.1515 if(id_fine>0) coefcoli_spla(id_fine) = 0.0011516 if(id_coss>0) coefcoli_spla(id_coss) = 0.0011517 if(id_codu>0) coefcoli_spla(id_codu) = 0.0011518 if(id_scdu>0) coefcoli_spla(id_scdu) = 0.0011514 IF(id_prec>0) coefcoli_spla(id_prec) = -9999. 1515 IF(id_fine>0) coefcoli_spla(id_fine) = 0.001 1516 IF(id_coss>0) coefcoli_spla(id_coss) = 0.001 1517 IF(id_codu>0) coefcoli_spla(id_codu) = 0.001 1518 IF(id_scdu>0) coefcoli_spla(id_scdu) = 0.001 1519 1519 1520 1520 !vdep_lic = (/0.2, 0.17, 1.2, 1.2/) 1521 1521 1522 1522 iscm3 = .FALSE. 1523 if (debutphy) then1523 if (debutphy) THEN 1524 1524 !$OMP MASTER 1525 1525 CALL suphel … … 1813 1813 ENDIF 1814 1814 1815 IF (debutphy) then 1816 1815 IF (debutphy) THEN 1817 1816 ! AS: initialisation des indices par point de grille physique iregion_* 1818 1817 ! (variables tenant de l'assimilation, a eliminer dans un 2eme temps) … … 2067 2066 #ifdef IOPHYS_DUST 2068 2067 do itr=1,nbtr 2069 write(str2,'(i2.2)') itr2068 WRITE(str2,'(i2.2)') itr 2070 2069 CALL iophys_ecrit('sav'//str2,1,'SOURCE','',source_tr(:,itr)) 2071 2070 CALL iophys_ecrit('fav'//str2,1,'SOURCE','',source_tr(:,itr)) 2072 2071 enddo 2073 2072 do itr=1,nbtr 2074 write(str2,'(i2.2)') itr2073 WRITE(str2,'(i2.2)') itr 2075 2074 CALL iophys_ecrit('TRB'//str2,klev,'SOURCE','',tr_seri(:,:,itr)) 2076 2075 enddo … … 2100 2099 #ifdef IOPHYS_DUST 2101 2100 do itr=1,nbtr 2102 write(str2,'(i2.2)') itr2101 WRITE(str2,'(i2.2)') itr 2103 2102 CALL iophys_ecrit('sap'//str2,1,'SOURCE','',source_tr(:,itr)) 2104 2103 CALL iophys_ecrit('fap'//str2,1,'SOURCE','',source_tr(:,itr)) … … 2197 2196 2198 2197 do itr=1,nbtr 2199 write(str2,'(i2.2)') itr2198 WRITE(str2,'(i2.2)') itr 2200 2199 CALL iophys_ecrit('tpr'//str2,1,'SOURCE','',source_tr(:,itr)) 2201 2200 CALL iophys_ecrit('fpr'//str2,1,'SOURCE','',flux_tr(:,itr)) … … 2241 2240 #ifdef IOPHYS_DUST 2242 2241 do itr=1,nbtr 2243 write(str2,'(i2.2)') itr2242 WRITE(str2,'(i2.2)') itr 2244 2243 CALL iophys_ecrit('t'//str2,1,'SOURCE','',source_tr(:,itr)) 2245 2244 CALL iophys_ecrit('f'//str2,1,'SOURCE','',flux_tr(:,itr)) … … 2297 2296 #ifdef IOPHYS_DUST 2298 2297 do itr=1,nbtr 2299 write(str2,'(i2.2)') itr2298 WRITE(str2,'(i2.2)') itr 2300 2299 CALL iophys_ecrit('TRC'//str2,klev,'SOURCE','',tr_seri(:,:,itr)) 2301 2300 enddo … … 2337 2336 #ifdef IOPHYS_DUST 2338 2337 do itr=1,nbtr 2339 write(str2,'(i2.2)') itr2338 WRITE(str2,'(i2.2)') itr 2340 2339 CALL iophys_ecrit('TRD'//str2,klev,'SOURCE','',tr_seri(:,:,itr)) 2341 2340 enddo … … 2411 2410 CALL iophys_ecrit('delp',klev,'delp','',delp) 2412 2411 do itr=1,nbtr 2413 write(str2,'(i2.2)') itr2412 WRITE(str2,'(i2.2)') itr 2414 2413 CALL iophys_ecrit('TRE'//str2,klev,'SOURCE','',tr_seri(:,:,itr)) 2415 2414 enddo … … 2603 2602 #ifdef IOPHYS_DUST 2604 2603 do itr=1,nbtr 2605 write(str2,'(i2.2)') itr2604 WRITE(str2,'(i2.2)') itr 2606 2605 CALL iophys_ecrit('TRF'//str2,klev,'SOURCE','',tr_seri(:,:,itr)) 2607 2606 enddo … … 2690 2689 #ifdef IOPHYS_DUST 2691 2690 do itr=1,nbtr 2692 write(str2,'(i2.2)') itr2691 WRITE(str2,'(i2.2)') itr 2693 2692 CALL iophys_ecrit('TRG'//str2,klev,'SOURCE','',tr_seri(:,:,itr)) 2694 2693 enddo … … 2855 2854 #ifdef IOPHYS_DUST 2856 2855 do itr=1,nbtr 2857 write(str2,'(i2.2)') itr2856 WRITE(str2,'(i2.2)') itr 2858 2857 CALL iophys_ecrit('TRH'//str2,klev,'SOURCE','',tr_seri(:,:,itr)) 2859 2858 enddo … … 3054 3053 3055 3054 do itr=1,nbtr 3056 write(str2,'(i2.2)') itr3055 WRITE(str2,'(i2.2)') itr 3057 3056 CALL iophys_ecrit('TRI'//str2,klev,'SOURCE','',tr_seri(:,:,itr)) 3058 3057 enddo … … 3175 3174 #ifdef IOPHYS_DUST 3176 3175 do itr=1,nbtr 3177 write(str2,'(i2.2)') itr3176 WRITE(str2,'(i2.2)') itr 3178 3177 CALL iophys_ecrit('TRJ'//str2,klev,'SOURCE','',tr_seri(:,:,itr)) 3179 3178 enddo … … 3441 3440 #ifdef IOPHYS_DUST 3442 3441 do itr=1,nbtr 3443 write(str2,'(i2.2)') itr3442 WRITE(str2,'(i2.2)') itr 3444 3443 CALL iophys_ecrit('TRK'//str2,klev,'SOURCE','',tr_seri(:,:,itr)) 3445 3444 enddo … … 3861 3860 !!!!!!!!!!!!!!!!!!!!!!!!!!!!! 3862 3861 3863 if(id_prec>0) trm01(i) = trm(i, id_prec)3864 if(id_fine>0) trm02(i) = trm(i, id_fine)3865 if(id_coss>0) trm03(i) = trm(i, id_coss)3866 if(id_codu>0) trm04(i) = trm(i, id_codu)3867 if(id_scdu>0) trm05(i) = trm(i, id_scdu)3868 if(id_prec>0) sconc01(i) = sconc_seri(i, id_prec)3869 if(id_fine>0) sconc02(i) = sconc_seri(i, id_fine)3870 if(id_coss>0) sconc03(i) = sconc_seri(i, id_coss)3871 if(id_codu>0) sconc04(i) = sconc_seri(i, id_codu)3872 if(id_scdu>0) sconc05(i) = sconc_seri(i, id_scdu)3873 if(id_prec>0) flux01(i) = flux_tr(i, id_prec)3874 if(id_fine>0) flux02(i) = flux_tr(i, id_fine)3875 if(id_coss>0) flux03(i) = flux_tr(i, id_coss)3876 if(id_codu>0) flux04(i) = flux_tr(i, id_codu)3877 if(id_scdu>0) flux05(i) = flux_tr(i, id_scdu)3878 if(id_prec>0) ds01(i) = his_ds(i, id_prec)3879 if(id_fine>0) ds02(i) = his_ds(i, id_fine)3880 if(id_coss>0) ds03(i) = his_ds(i, id_coss)3881 if(id_codu>0) ds04(i) = his_ds(i, id_codu)3882 if(id_scdu>0) ds05(i) = his_ds(i, id_scdu)3883 if(id_prec>0) dh01(i) = his_dh(i, id_prec)3884 if(id_fine>0) dh02(i) = his_dh(i, id_fine)3885 if(id_coss>0) dh03(i) = his_dh(i, id_coss)3886 if(id_codu>0) dh04(i) = his_dh(i, id_codu)3887 if(id_scdu>0) dh05(i) = his_dh(i, id_scdu)3888 if(id_prec>0) dtrconv01(i) = dtrconv(i, id_prec)3889 if(id_fine>0) dtrconv02(i) = dtrconv(i, id_fine)3890 if(id_coss>0) dtrconv03(i) = dtrconv(i, id_coss)3891 if(id_codu>0) dtrconv04(i) = dtrconv(i, id_codu)3892 if(id_scdu>0) dtrconv05(i) = dtrconv(i, id_scdu)3893 if(id_prec>0) dtherm01(i) = his_th(i, id_prec)3894 if(id_fine>0) dtherm02(i) = his_th(i, id_fine)3895 if(id_coss>0) dtherm03(i) = his_th(i, id_coss)3896 if(id_codu>0) dtherm04(i) = his_th(i, id_codu)3897 if(id_scdu>0) dtherm05(i) = his_th(i, id_scdu)3898 if(id_prec>0) dhkecv01(i) = his_dhkecv(i, id_prec)3899 if(id_fine>0) dhkecv02(i) = his_dhkecv(i, id_fine)3900 if(id_coss>0) dhkecv03(i) = his_dhkecv(i, id_coss)3901 if(id_codu>0) dhkecv04(i) = his_dhkecv(i, id_codu)3902 if(id_scdu>0) dhkecv05(i) = his_dhkecv(i, id_scdu)3903 if(id_prec>0) d_tr_ds01(i) = his_ds(i, id_prec)3904 if(id_fine>0) d_tr_ds02(i) = his_ds(i, id_fine)3905 if(id_coss>0) d_tr_ds03(i) = his_ds(i, id_coss)3906 if(id_codu>0) d_tr_ds04(i) = his_ds(i, id_codu)3907 if(id_scdu>0) d_tr_ds05(i) = his_ds(i, id_scdu)3908 if(id_prec>0) dhkelsc01(i) = his_dhkelsc(i, id_prec)3909 if(id_fine>0) dhkelsc02(i) = his_dhkelsc(i, id_fine)3910 if(id_coss>0) dhkelsc03(i) = his_dhkelsc(i, id_coss)3911 if(id_codu>0) dhkelsc04(i) = his_dhkelsc(i, id_codu)3912 if(id_scdu>0) dhkelsc05(i) = his_dhkelsc(i, id_scdu)3862 IF(id_prec>0) trm01(i) = trm(i, id_prec) 3863 IF(id_fine>0) trm02(i) = trm(i, id_fine) 3864 IF(id_coss>0) trm03(i) = trm(i, id_coss) 3865 IF(id_codu>0) trm04(i) = trm(i, id_codu) 3866 IF(id_scdu>0) trm05(i) = trm(i, id_scdu) 3867 IF(id_prec>0) sconc01(i) = sconc_seri(i, id_prec) 3868 IF(id_fine>0) sconc02(i) = sconc_seri(i, id_fine) 3869 IF(id_coss>0) sconc03(i) = sconc_seri(i, id_coss) 3870 IF(id_codu>0) sconc04(i) = sconc_seri(i, id_codu) 3871 IF(id_scdu>0) sconc05(i) = sconc_seri(i, id_scdu) 3872 IF(id_prec>0) flux01(i) = flux_tr(i, id_prec) 3873 IF(id_fine>0) flux02(i) = flux_tr(i, id_fine) 3874 IF(id_coss>0) flux03(i) = flux_tr(i, id_coss) 3875 IF(id_codu>0) flux04(i) = flux_tr(i, id_codu) 3876 IF(id_scdu>0) flux05(i) = flux_tr(i, id_scdu) 3877 IF(id_prec>0) ds01(i) = his_ds(i, id_prec) 3878 IF(id_fine>0) ds02(i) = his_ds(i, id_fine) 3879 IF(id_coss>0) ds03(i) = his_ds(i, id_coss) 3880 IF(id_codu>0) ds04(i) = his_ds(i, id_codu) 3881 IF(id_scdu>0) ds05(i) = his_ds(i, id_scdu) 3882 IF(id_prec>0) dh01(i) = his_dh(i, id_prec) 3883 IF(id_fine>0) dh02(i) = his_dh(i, id_fine) 3884 IF(id_coss>0) dh03(i) = his_dh(i, id_coss) 3885 IF(id_codu>0) dh04(i) = his_dh(i, id_codu) 3886 IF(id_scdu>0) dh05(i) = his_dh(i, id_scdu) 3887 IF(id_prec>0) dtrconv01(i) = dtrconv(i, id_prec) 3888 IF(id_fine>0) dtrconv02(i) = dtrconv(i, id_fine) 3889 IF(id_coss>0) dtrconv03(i) = dtrconv(i, id_coss) 3890 IF(id_codu>0) dtrconv04(i) = dtrconv(i, id_codu) 3891 IF(id_scdu>0) dtrconv05(i) = dtrconv(i, id_scdu) 3892 IF(id_prec>0) dtherm01(i) = his_th(i, id_prec) 3893 IF(id_fine>0) dtherm02(i) = his_th(i, id_fine) 3894 IF(id_coss>0) dtherm03(i) = his_th(i, id_coss) 3895 IF(id_codu>0) dtherm04(i) = his_th(i, id_codu) 3896 IF(id_scdu>0) dtherm05(i) = his_th(i, id_scdu) 3897 IF(id_prec>0) dhkecv01(i) = his_dhkecv(i, id_prec) 3898 IF(id_fine>0) dhkecv02(i) = his_dhkecv(i, id_fine) 3899 IF(id_coss>0) dhkecv03(i) = his_dhkecv(i, id_coss) 3900 IF(id_codu>0) dhkecv04(i) = his_dhkecv(i, id_codu) 3901 IF(id_scdu>0) dhkecv05(i) = his_dhkecv(i, id_scdu) 3902 IF(id_prec>0) d_tr_ds01(i) = his_ds(i, id_prec) 3903 IF(id_fine>0) d_tr_ds02(i) = his_ds(i, id_fine) 3904 IF(id_coss>0) d_tr_ds03(i) = his_ds(i, id_coss) 3905 IF(id_codu>0) d_tr_ds04(i) = his_ds(i, id_codu) 3906 IF(id_scdu>0) d_tr_ds05(i) = his_ds(i, id_scdu) 3907 IF(id_prec>0) dhkelsc01(i) = his_dhkelsc(i, id_prec) 3908 IF(id_fine>0) dhkelsc02(i) = his_dhkelsc(i, id_fine) 3909 IF(id_coss>0) dhkelsc03(i) = his_dhkelsc(i, id_coss) 3910 IF(id_codu>0) dhkelsc04(i) = his_dhkelsc(i, id_codu) 3911 IF(id_scdu>0) dhkelsc05(i) = his_dhkelsc(i, id_scdu) 3913 3912 u10m_ss(i) = u10m_ec(i) 3914 3913 v10m_ss(i) = v10m_ec(i) … … 3985 3984 DO k = 1, klev 3986 3985 3987 if(id_prec>0) d_tr_cv01(i, k) = d_tr_cv_o(i, k, id_prec)3988 if(id_fine>0) d_tr_cv02(i, k) = d_tr_cv_o(i, k, id_fine)3989 if(id_coss>0) d_tr_cv03(i, k) = d_tr_cv_o(i, k, id_coss)3990 if(id_codu>0) d_tr_cv04(i, k) = d_tr_cv_o(i, k, id_codu)3991 if(id_scdu>0) d_tr_cv05(i, k) = d_tr_cv_o(i, k, id_scdu)3992 if(id_prec>0) d_tr_trsp01(i, k) = d_tr_trsp_o(i, k, id_prec)3993 if(id_fine>0) d_tr_trsp02(i, k) = d_tr_trsp_o(i, k, id_fine)3994 if(id_coss>0) d_tr_trsp03(i, k) = d_tr_trsp_o(i, k, id_coss)3995 if(id_codu>0) d_tr_trsp04(i, k) = d_tr_trsp_o(i, k, id_codu)3996 if(id_scdu>0) d_tr_trsp05(i, k) = d_tr_trsp_o(i, k, id_scdu)3997 if(id_prec>0) d_tr_sscav01(i, k) = d_tr_sscav_o(i, k, id_prec)3998 if(id_fine>0) d_tr_sscav02(i, k) = d_tr_sscav_o(i, k, id_fine)3999 if(id_coss>0) d_tr_sscav03(i, k) = d_tr_sscav_o(i, k, id_coss)4000 if(id_codu>0) d_tr_sscav04(i, k) = d_tr_sscav_o(i, k, id_codu)4001 if(id_scdu>0) d_tr_sscav05(i, k) = d_tr_sscav_o(i, k, id_scdu)4002 if(id_prec>0) d_tr_sat01(i, k) = d_tr_sat_o(i, k, id_prec)4003 if(id_fine>0) d_tr_sat02(i, k) = d_tr_sat_o(i, k, id_fine)4004 if(id_coss>0) d_tr_sat03(i, k) = d_tr_sat_o(i, k, id_coss)4005 if(id_codu>0) d_tr_sat04(i, k) = d_tr_sat_o(i, k, id_codu)4006 if(id_scdu>0) d_tr_sat05(i, k) = d_tr_sat_o(i, k, id_scdu)4007 if(id_prec>0) d_tr_uscav01(i, k) = d_tr_uscav_o(i, k, id_prec)4008 if(id_fine>0) d_tr_uscav02(i, k) = d_tr_uscav_o(i, k, id_fine)4009 if(id_coss>0) d_tr_uscav03(i, k) = d_tr_uscav_o(i, k, id_coss)4010 if(id_codu>0) d_tr_uscav04(i, k) = d_tr_uscav_o(i, k, id_codu)4011 if(id_scdu>0) d_tr_uscav05(i, k) = d_tr_uscav_o(i, k, id_scdu)4012 if(id_prec>0) d_tr_insc01(i, k) = d_tr_insc_o(i, k, id_prec)4013 if(id_fine>0) d_tr_insc02(i, k) = d_tr_insc_o(i, k, id_fine)4014 if(id_coss>0) d_tr_insc03(i, k) = d_tr_insc_o(i, k, id_coss)4015 if(id_codu>0) d_tr_insc04(i, k) = d_tr_insc_o(i, k, id_codu)4016 if(id_scdu>0) d_tr_insc05(i, k) = d_tr_insc_o(i, k, id_scdu)4017 if(id_prec>0) d_tr_bcscav01(i, k) = d_tr_bcscav_o(i, k, id_prec)4018 if(id_fine>0) d_tr_bcscav02(i, k) = d_tr_bcscav_o(i, k, id_fine)4019 if(id_coss>0) d_tr_bcscav03(i, k) = d_tr_bcscav_o(i, k, id_coss)4020 if(id_codu>0) d_tr_bcscav04(i, k) = d_tr_bcscav_o(i, k, id_codu)4021 if(id_scdu>0) d_tr_bcscav05(i, k) = d_tr_bcscav_o(i, k, id_scdu)4022 if(id_prec>0) d_tr_evapls01(i, k) = d_tr_evapls_o(i, k, id_prec)4023 if(id_fine>0) d_tr_evapls02(i, k) = d_tr_evapls_o(i, k, id_fine)4024 if(id_coss>0) d_tr_evapls03(i, k) = d_tr_evapls_o(i, k, id_coss)4025 if(id_codu>0) d_tr_evapls04(i, k) = d_tr_evapls_o(i, k, id_codu)4026 if(id_scdu>0) d_tr_evapls05(i, k) = d_tr_evapls_o(i, k, id_scdu)3986 IF(id_prec>0) d_tr_cv01(i, k) = d_tr_cv_o(i, k, id_prec) 3987 IF(id_fine>0) d_tr_cv02(i, k) = d_tr_cv_o(i, k, id_fine) 3988 IF(id_coss>0) d_tr_cv03(i, k) = d_tr_cv_o(i, k, id_coss) 3989 IF(id_codu>0) d_tr_cv04(i, k) = d_tr_cv_o(i, k, id_codu) 3990 IF(id_scdu>0) d_tr_cv05(i, k) = d_tr_cv_o(i, k, id_scdu) 3991 IF(id_prec>0) d_tr_trsp01(i, k) = d_tr_trsp_o(i, k, id_prec) 3992 IF(id_fine>0) d_tr_trsp02(i, k) = d_tr_trsp_o(i, k, id_fine) 3993 IF(id_coss>0) d_tr_trsp03(i, k) = d_tr_trsp_o(i, k, id_coss) 3994 IF(id_codu>0) d_tr_trsp04(i, k) = d_tr_trsp_o(i, k, id_codu) 3995 IF(id_scdu>0) d_tr_trsp05(i, k) = d_tr_trsp_o(i, k, id_scdu) 3996 IF(id_prec>0) d_tr_sscav01(i, k) = d_tr_sscav_o(i, k, id_prec) 3997 IF(id_fine>0) d_tr_sscav02(i, k) = d_tr_sscav_o(i, k, id_fine) 3998 IF(id_coss>0) d_tr_sscav03(i, k) = d_tr_sscav_o(i, k, id_coss) 3999 IF(id_codu>0) d_tr_sscav04(i, k) = d_tr_sscav_o(i, k, id_codu) 4000 IF(id_scdu>0) d_tr_sscav05(i, k) = d_tr_sscav_o(i, k, id_scdu) 4001 IF(id_prec>0) d_tr_sat01(i, k) = d_tr_sat_o(i, k, id_prec) 4002 IF(id_fine>0) d_tr_sat02(i, k) = d_tr_sat_o(i, k, id_fine) 4003 IF(id_coss>0) d_tr_sat03(i, k) = d_tr_sat_o(i, k, id_coss) 4004 IF(id_codu>0) d_tr_sat04(i, k) = d_tr_sat_o(i, k, id_codu) 4005 IF(id_scdu>0) d_tr_sat05(i, k) = d_tr_sat_o(i, k, id_scdu) 4006 IF(id_prec>0) d_tr_uscav01(i, k) = d_tr_uscav_o(i, k, id_prec) 4007 IF(id_fine>0) d_tr_uscav02(i, k) = d_tr_uscav_o(i, k, id_fine) 4008 IF(id_coss>0) d_tr_uscav03(i, k) = d_tr_uscav_o(i, k, id_coss) 4009 IF(id_codu>0) d_tr_uscav04(i, k) = d_tr_uscav_o(i, k, id_codu) 4010 IF(id_scdu>0) d_tr_uscav05(i, k) = d_tr_uscav_o(i, k, id_scdu) 4011 IF(id_prec>0) d_tr_insc01(i, k) = d_tr_insc_o(i, k, id_prec) 4012 IF(id_fine>0) d_tr_insc02(i, k) = d_tr_insc_o(i, k, id_fine) 4013 IF(id_coss>0) d_tr_insc03(i, k) = d_tr_insc_o(i, k, id_coss) 4014 IF(id_codu>0) d_tr_insc04(i, k) = d_tr_insc_o(i, k, id_codu) 4015 IF(id_scdu>0) d_tr_insc05(i, k) = d_tr_insc_o(i, k, id_scdu) 4016 IF(id_prec>0) d_tr_bcscav01(i, k) = d_tr_bcscav_o(i, k, id_prec) 4017 IF(id_fine>0) d_tr_bcscav02(i, k) = d_tr_bcscav_o(i, k, id_fine) 4018 IF(id_coss>0) d_tr_bcscav03(i, k) = d_tr_bcscav_o(i, k, id_coss) 4019 IF(id_codu>0) d_tr_bcscav04(i, k) = d_tr_bcscav_o(i, k, id_codu) 4020 IF(id_scdu>0) d_tr_bcscav05(i, k) = d_tr_bcscav_o(i, k, id_scdu) 4021 IF(id_prec>0) d_tr_evapls01(i, k) = d_tr_evapls_o(i, k, id_prec) 4022 IF(id_fine>0) d_tr_evapls02(i, k) = d_tr_evapls_o(i, k, id_fine) 4023 IF(id_coss>0) d_tr_evapls03(i, k) = d_tr_evapls_o(i, k, id_coss) 4024 IF(id_codu>0) d_tr_evapls04(i, k) = d_tr_evapls_o(i, k, id_codu) 4025 IF(id_scdu>0) d_tr_evapls05(i, k) = d_tr_evapls_o(i, k, id_scdu) 4027 4026 ENDDO 4028 4027 ENDDO … … 4030 4029 DO i = 1, klon 4031 4030 DO k = 1, klev 4032 if(id_prec>0) d_tr_cv01(i, k) = d_tr_cv(i, k, id_prec) / pdtphys4033 if(id_fine>0) d_tr_cv02(i, k) = d_tr_cv(i, k, id_fine) / pdtphys4034 if(id_coss>0) d_tr_cv03(i, k) = d_tr_cv(i, k, id_coss) / pdtphys4035 if(id_codu>0) d_tr_cv04(i, k) = d_tr_cv(i, k, id_codu) / pdtphys4036 if(id_scdu>0) d_tr_cv05(i, k) = d_tr_cv(i, k, id_scdu) / pdtphys4037 if(id_prec>0) d_tr_trsp01(i, k) = d_tr_trsp(i, k, id_prec) / pdtphys4038 if(id_fine>0) d_tr_trsp02(i, k) = d_tr_trsp(i, k, id_fine) / pdtphys4039 if(id_coss>0) d_tr_trsp03(i, k) = d_tr_trsp(i, k, id_coss) / pdtphys4040 if(id_codu>0) d_tr_trsp04(i, k) = d_tr_trsp(i, k, id_codu) / pdtphys4041 if(id_scdu>0) d_tr_trsp05(i, k) = d_tr_trsp(i, k, id_scdu) / pdtphys4042 if(id_prec>0) d_tr_sscav01(i, k) = d_tr_sscav(i, k, id_prec) / pdtphys4043 if(id_fine>0) d_tr_sscav02(i, k) = d_tr_sscav(i, k, id_fine) / pdtphys4044 if(id_coss>0) d_tr_sscav03(i, k) = d_tr_sscav(i, k, id_coss) / pdtphys4045 if(id_codu>0) d_tr_sscav04(i, k) = d_tr_sscav(i, k, id_codu) / pdtphys4046 if(id_scdu>0) d_tr_sscav05(i, k) = d_tr_sscav(i, k, id_scdu) / pdtphys4047 if(id_prec>0) d_tr_sat01(i, k) = d_tr_sat(i, k, id_prec) / pdtphys4048 if(id_fine>0) d_tr_sat02(i, k) = d_tr_sat(i, k, id_fine) / pdtphys4049 if(id_coss>0) d_tr_sat03(i, k) = d_tr_sat(i, k, id_coss) / pdtphys4050 if(id_codu>0) d_tr_sat04(i, k) = d_tr_sat(i, k, id_codu) / pdtphys4051 if(id_scdu>0) d_tr_sat05(i, k) = d_tr_sat(i, k, id_scdu) / pdtphys4052 if(id_prec>0) d_tr_uscav01(i, k) = d_tr_uscav(i, k, id_prec) / pdtphys4053 if(id_fine>0) d_tr_uscav02(i, k) = d_tr_uscav(i, k, id_fine) / pdtphys4054 if(id_coss>0) d_tr_uscav03(i, k) = d_tr_uscav(i, k, id_coss) / pdtphys4055 if(id_codu>0) d_tr_uscav04(i, k) = d_tr_uscav(i, k, id_codu) / pdtphys4056 if(id_scdu>0) d_tr_uscav05(i, k) = d_tr_uscav(i, k, id_scdu) / pdtphys4057 if(id_prec>0) d_tr_insc01(i, k) = d_tr_insc(i, k, id_prec) / pdtphys4058 if(id_fine>0) d_tr_insc02(i, k) = d_tr_insc(i, k, id_fine) / pdtphys4059 if(id_coss>0) d_tr_insc03(i, k) = d_tr_insc(i, k, id_coss) / pdtphys4060 if(id_codu>0) d_tr_insc04(i, k) = d_tr_insc(i, k, id_codu) / pdtphys4061 if(id_scdu>0) d_tr_insc05(i, k) = d_tr_insc(i, k, id_scdu) / pdtphys4062 if(id_prec>0) d_tr_bcscav01(i, k) = d_tr_bcscav(i, k, id_prec) / pdtphys4063 if(id_fine>0) d_tr_bcscav02(i, k) = d_tr_bcscav(i, k, id_fine) / pdtphys4064 if(id_coss>0) d_tr_bcscav03(i, k) = d_tr_bcscav(i, k, id_coss) / pdtphys4065 if(id_codu>0) d_tr_bcscav04(i, k) = d_tr_bcscav(i, k, id_codu) / pdtphys4066 if(id_scdu>0) d_tr_bcscav05(i, k) = d_tr_bcscav(i, k, id_scdu) / pdtphys4067 if(id_prec>0) d_tr_evapls01(i, k) = d_tr_evapls(i, k, id_prec) / pdtphys4068 if(id_fine>0) d_tr_evapls02(i, k) = d_tr_evapls(i, k, id_fine) / pdtphys4069 if(id_coss>0) d_tr_evapls03(i, k) = d_tr_evapls(i, k, id_coss) / pdtphys4070 if(id_codu>0) d_tr_evapls04(i, k) = d_tr_evapls(i, k, id_codu) / pdtphys4071 if(id_scdu>0) d_tr_evapls05(i, k) = d_tr_evapls(i, k, id_scdu) / pdtphys4031 IF(id_prec>0) d_tr_cv01(i, k) = d_tr_cv(i, k, id_prec) / pdtphys 4032 IF(id_fine>0) d_tr_cv02(i, k) = d_tr_cv(i, k, id_fine) / pdtphys 4033 IF(id_coss>0) d_tr_cv03(i, k) = d_tr_cv(i, k, id_coss) / pdtphys 4034 IF(id_codu>0) d_tr_cv04(i, k) = d_tr_cv(i, k, id_codu) / pdtphys 4035 IF(id_scdu>0) d_tr_cv05(i, k) = d_tr_cv(i, k, id_scdu) / pdtphys 4036 IF(id_prec>0) d_tr_trsp01(i, k) = d_tr_trsp(i, k, id_prec) / pdtphys 4037 IF(id_fine>0) d_tr_trsp02(i, k) = d_tr_trsp(i, k, id_fine) / pdtphys 4038 IF(id_coss>0) d_tr_trsp03(i, k) = d_tr_trsp(i, k, id_coss) / pdtphys 4039 IF(id_codu>0) d_tr_trsp04(i, k) = d_tr_trsp(i, k, id_codu) / pdtphys 4040 IF(id_scdu>0) d_tr_trsp05(i, k) = d_tr_trsp(i, k, id_scdu) / pdtphys 4041 IF(id_prec>0) d_tr_sscav01(i, k) = d_tr_sscav(i, k, id_prec) / pdtphys 4042 IF(id_fine>0) d_tr_sscav02(i, k) = d_tr_sscav(i, k, id_fine) / pdtphys 4043 IF(id_coss>0) d_tr_sscav03(i, k) = d_tr_sscav(i, k, id_coss) / pdtphys 4044 IF(id_codu>0) d_tr_sscav04(i, k) = d_tr_sscav(i, k, id_codu) / pdtphys 4045 IF(id_scdu>0) d_tr_sscav05(i, k) = d_tr_sscav(i, k, id_scdu) / pdtphys 4046 IF(id_prec>0) d_tr_sat01(i, k) = d_tr_sat(i, k, id_prec) / pdtphys 4047 IF(id_fine>0) d_tr_sat02(i, k) = d_tr_sat(i, k, id_fine) / pdtphys 4048 IF(id_coss>0) d_tr_sat03(i, k) = d_tr_sat(i, k, id_coss) / pdtphys 4049 IF(id_codu>0) d_tr_sat04(i, k) = d_tr_sat(i, k, id_codu) / pdtphys 4050 IF(id_scdu>0) d_tr_sat05(i, k) = d_tr_sat(i, k, id_scdu) / pdtphys 4051 IF(id_prec>0) d_tr_uscav01(i, k) = d_tr_uscav(i, k, id_prec) / pdtphys 4052 IF(id_fine>0) d_tr_uscav02(i, k) = d_tr_uscav(i, k, id_fine) / pdtphys 4053 IF(id_coss>0) d_tr_uscav03(i, k) = d_tr_uscav(i, k, id_coss) / pdtphys 4054 IF(id_codu>0) d_tr_uscav04(i, k) = d_tr_uscav(i, k, id_codu) / pdtphys 4055 IF(id_scdu>0) d_tr_uscav05(i, k) = d_tr_uscav(i, k, id_scdu) / pdtphys 4056 IF(id_prec>0) d_tr_insc01(i, k) = d_tr_insc(i, k, id_prec) / pdtphys 4057 IF(id_fine>0) d_tr_insc02(i, k) = d_tr_insc(i, k, id_fine) / pdtphys 4058 IF(id_coss>0) d_tr_insc03(i, k) = d_tr_insc(i, k, id_coss) / pdtphys 4059 IF(id_codu>0) d_tr_insc04(i, k) = d_tr_insc(i, k, id_codu) / pdtphys 4060 IF(id_scdu>0) d_tr_insc05(i, k) = d_tr_insc(i, k, id_scdu) / pdtphys 4061 IF(id_prec>0) d_tr_bcscav01(i, k) = d_tr_bcscav(i, k, id_prec) / pdtphys 4062 IF(id_fine>0) d_tr_bcscav02(i, k) = d_tr_bcscav(i, k, id_fine) / pdtphys 4063 IF(id_coss>0) d_tr_bcscav03(i, k) = d_tr_bcscav(i, k, id_coss) / pdtphys 4064 IF(id_codu>0) d_tr_bcscav04(i, k) = d_tr_bcscav(i, k, id_codu) / pdtphys 4065 IF(id_scdu>0) d_tr_bcscav05(i, k) = d_tr_bcscav(i, k, id_scdu) / pdtphys 4066 IF(id_prec>0) d_tr_evapls01(i, k) = d_tr_evapls(i, k, id_prec) / pdtphys 4067 IF(id_fine>0) d_tr_evapls02(i, k) = d_tr_evapls(i, k, id_fine) / pdtphys 4068 IF(id_coss>0) d_tr_evapls03(i, k) = d_tr_evapls(i, k, id_coss) / pdtphys 4069 IF(id_codu>0) d_tr_evapls04(i, k) = d_tr_evapls(i, k, id_codu) / pdtphys 4070 IF(id_scdu>0) d_tr_evapls05(i, k) = d_tr_evapls(i, k, id_scdu) / pdtphys 4072 4071 ENDDO 4073 4072 ENDDO … … 4077 4076 DO i = 1, klon 4078 4077 DO k = 1, klev 4079 if(id_prec>0) d_tr_ls01(i, k) = d_tr_ls_o(i, k, id_prec)4080 if(id_fine>0) d_tr_ls02(i, k) = d_tr_ls_o(i, k, id_fine)4081 if(id_coss>0) d_tr_ls03(i, k) = d_tr_ls_o(i, k, id_coss)4082 if(id_codu>0) d_tr_ls04(i, k) = d_tr_ls_o(i, k, id_codu)4083 if(id_scdu>0) d_tr_ls05(i, k) = d_tr_ls_o(i, k, id_scdu)4084 if(id_prec>0) d_tr_dyn01(i, k) = d_tr_dyn_o(i, k, id_prec)4085 if(id_fine>0) d_tr_dyn02(i, k) = d_tr_dyn_o(i, k, id_fine)4086 if(id_coss>0) d_tr_dyn03(i, k) = d_tr_dyn_o(i, k, id_coss)4087 if(id_codu>0) d_tr_dyn04(i, k) = d_tr_dyn_o(i, k, id_codu)4088 if(id_scdu>0) d_tr_dyn05(i, k) = d_tr_dyn_o(i, k, id_scdu)4089 if(id_prec>0) d_tr_cl01(i, k) = d_tr_cl_o(i, k, id_prec)4090 if(id_fine>0) d_tr_cl02(i, k) = d_tr_cl_o(i, k, id_fine)4091 if(id_coss>0) d_tr_cl03(i, k) = d_tr_cl_o(i, k, id_coss)4092 if(id_codu>0) d_tr_cl04(i, k) = d_tr_cl_o(i, k, id_codu)4093 if(id_scdu>0) d_tr_cl05(i, k) = d_tr_cl_o(i, k, id_scdu)4094 if(id_prec>0) d_tr_th01(i, k) = d_tr_th_o(i, k, id_prec)4095 if(id_fine>0) d_tr_th02(i, k) = d_tr_th_o(i, k, id_fine)4096 if(id_coss>0) d_tr_th03(i, k) = d_tr_th_o(i, k, id_coss)4097 if(id_codu>0) d_tr_th04(i, k) = d_tr_th_o(i, k, id_codu)4098 if(id_scdu>0) d_tr_th05(i, k) = d_tr_th_o(i, k, id_scdu)4078 IF(id_prec>0) d_tr_ls01(i, k) = d_tr_ls_o(i, k, id_prec) 4079 IF(id_fine>0) d_tr_ls02(i, k) = d_tr_ls_o(i, k, id_fine) 4080 IF(id_coss>0) d_tr_ls03(i, k) = d_tr_ls_o(i, k, id_coss) 4081 IF(id_codu>0) d_tr_ls04(i, k) = d_tr_ls_o(i, k, id_codu) 4082 IF(id_scdu>0) d_tr_ls05(i, k) = d_tr_ls_o(i, k, id_scdu) 4083 IF(id_prec>0) d_tr_dyn01(i, k) = d_tr_dyn_o(i, k, id_prec) 4084 IF(id_fine>0) d_tr_dyn02(i, k) = d_tr_dyn_o(i, k, id_fine) 4085 IF(id_coss>0) d_tr_dyn03(i, k) = d_tr_dyn_o(i, k, id_coss) 4086 IF(id_codu>0) d_tr_dyn04(i, k) = d_tr_dyn_o(i, k, id_codu) 4087 IF(id_scdu>0) d_tr_dyn05(i, k) = d_tr_dyn_o(i, k, id_scdu) 4088 IF(id_prec>0) d_tr_cl01(i, k) = d_tr_cl_o(i, k, id_prec) 4089 IF(id_fine>0) d_tr_cl02(i, k) = d_tr_cl_o(i, k, id_fine) 4090 IF(id_coss>0) d_tr_cl03(i, k) = d_tr_cl_o(i, k, id_coss) 4091 IF(id_codu>0) d_tr_cl04(i, k) = d_tr_cl_o(i, k, id_codu) 4092 IF(id_scdu>0) d_tr_cl05(i, k) = d_tr_cl_o(i, k, id_scdu) 4093 IF(id_prec>0) d_tr_th01(i, k) = d_tr_th_o(i, k, id_prec) 4094 IF(id_fine>0) d_tr_th02(i, k) = d_tr_th_o(i, k, id_fine) 4095 IF(id_coss>0) d_tr_th03(i, k) = d_tr_th_o(i, k, id_coss) 4096 IF(id_codu>0) d_tr_th04(i, k) = d_tr_th_o(i, k, id_codu) 4097 IF(id_scdu>0) d_tr_th05(i, k) = d_tr_th_o(i, k, id_scdu) 4099 4098 ENDDO 4100 4099 ENDDO … … 4102 4101 DO i = 1, klon 4103 4102 DO k = 1, klev 4104 if(id_prec>0) d_tr_ls01(i, k) = d_tr_ls(i, k, id_prec) / pdtphys4105 if(id_fine>0) d_tr_ls02(i, k) = d_tr_ls(i, k, id_fine) / pdtphys4106 if(id_coss>0) d_tr_ls03(i, k) = d_tr_ls(i, k, id_coss) / pdtphys4107 if(id_codu>0) d_tr_ls04(i, k) = d_tr_ls(i, k, id_codu) / pdtphys4108 if(id_scdu>0) d_tr_ls05(i, k) = d_tr_ls(i, k, id_scdu) / pdtphys4109 if(id_prec>0) d_tr_dyn01(i, k) = d_tr_dyn(i, k, id_prec) / pdtphys4110 if(id_fine>0) d_tr_dyn02(i, k) = d_tr_dyn(i, k, id_fine) / pdtphys4111 if(id_coss>0) d_tr_dyn03(i, k) = d_tr_dyn(i, k, id_coss) / pdtphys4112 if(id_codu>0) d_tr_dyn04(i, k) = d_tr_dyn(i, k, id_codu) / pdtphys4113 if(id_scdu>0) d_tr_dyn05(i, k) = d_tr_dyn(i, k, id_scdu) / pdtphys4114 if(id_prec>0) d_tr_cl01(i, k) = d_tr_cl(i, k, id_prec) / pdtphys4115 if(id_fine>0) d_tr_cl02(i, k) = d_tr_cl(i, k, id_fine) / pdtphys4116 if(id_coss>0) d_tr_cl03(i, k) = d_tr_cl(i, k, id_coss) / pdtphys4117 if(id_codu>0) d_tr_cl04(i, k) = d_tr_cl(i, k, id_codu) / pdtphys4118 if(id_scdu>0) d_tr_cl05(i, k) = d_tr_cl(i, k, id_scdu) / pdtphys4119 if(id_prec>0) d_tr_th01(i, k) = d_tr_th(i, k, id_prec) / pdtphys4120 if(id_fine>0) d_tr_th02(i, k) = d_tr_th(i, k, id_fine) / pdtphys4121 if(id_coss>0) d_tr_th03(i, k) = d_tr_th(i, k, id_coss) / pdtphys4122 if(id_codu>0) d_tr_th04(i, k) = d_tr_th(i, k, id_codu) / pdtphys4123 if(id_scdu>0) d_tr_th05(i, k) = d_tr_th(i, k, id_scdu) / pdtphys4103 IF(id_prec>0) d_tr_ls01(i, k) = d_tr_ls(i, k, id_prec) / pdtphys 4104 IF(id_fine>0) d_tr_ls02(i, k) = d_tr_ls(i, k, id_fine) / pdtphys 4105 IF(id_coss>0) d_tr_ls03(i, k) = d_tr_ls(i, k, id_coss) / pdtphys 4106 IF(id_codu>0) d_tr_ls04(i, k) = d_tr_ls(i, k, id_codu) / pdtphys 4107 IF(id_scdu>0) d_tr_ls05(i, k) = d_tr_ls(i, k, id_scdu) / pdtphys 4108 IF(id_prec>0) d_tr_dyn01(i, k) = d_tr_dyn(i, k, id_prec) / pdtphys 4109 IF(id_fine>0) d_tr_dyn02(i, k) = d_tr_dyn(i, k, id_fine) / pdtphys 4110 IF(id_coss>0) d_tr_dyn03(i, k) = d_tr_dyn(i, k, id_coss) / pdtphys 4111 IF(id_codu>0) d_tr_dyn04(i, k) = d_tr_dyn(i, k, id_codu) / pdtphys 4112 IF(id_scdu>0) d_tr_dyn05(i, k) = d_tr_dyn(i, k, id_scdu) / pdtphys 4113 IF(id_prec>0) d_tr_cl01(i, k) = d_tr_cl(i, k, id_prec) / pdtphys 4114 IF(id_fine>0) d_tr_cl02(i, k) = d_tr_cl(i, k, id_fine) / pdtphys 4115 IF(id_coss>0) d_tr_cl03(i, k) = d_tr_cl(i, k, id_coss) / pdtphys 4116 IF(id_codu>0) d_tr_cl04(i, k) = d_tr_cl(i, k, id_codu) / pdtphys 4117 IF(id_scdu>0) d_tr_cl05(i, k) = d_tr_cl(i, k, id_scdu) / pdtphys 4118 IF(id_prec>0) d_tr_th01(i, k) = d_tr_th(i, k, id_prec) / pdtphys 4119 IF(id_fine>0) d_tr_th02(i, k) = d_tr_th(i, k, id_fine) / pdtphys 4120 IF(id_coss>0) d_tr_th03(i, k) = d_tr_th(i, k, id_coss) / pdtphys 4121 IF(id_codu>0) d_tr_th04(i, k) = d_tr_th(i, k, id_codu) / pdtphys 4122 IF(id_scdu>0) d_tr_th05(i, k) = d_tr_th(i, k, id_scdu) / pdtphys 4124 4123 ENDDO 4125 4124 ENDDO -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_dust.f90
r5110 r5116 11 11 INTEGER :: step, nbjour 12 12 LOGICAL :: debutphy 13 real:: dust_ec(klon)14 real:: dust_ec_glo(klon_glo)13 REAL :: dust_ec(klon) 14 REAL :: dust_ec_glo(klon_glo) 15 15 16 16 ! as real dust_nc(iip1,jjp1) 17 real:: dust_nc_glo(nbp_lon + 1, nbp_lat)18 integer:: rcode19 integer:: ncid1, varid1, ncid2, varid217 REAL :: dust_nc_glo(nbp_lon + 1, nbp_lat) 18 INTEGER :: rcode 19 INTEGER :: ncid1, varid1, ncid2, varid2 20 20 21 21 save ncid1, varid1, ncid2, varid2 22 22 !$OMP THREADPRIVATE(ncid1, varid1, ncid2, varid2) 23 integer:: start(4), count(4), status24 integer:: i, j, ig23 INTEGER :: start(4), count(4), status 24 INTEGER :: i, j, ig 25 25 26 26 !$OMP MASTER 27 27 IF (is_mpi_root .AND. is_omp_root) THEN 28 if (debutphy) then28 if (debutphy) THEN 29 29 ncid1 = nf90_open('dust.nc', nf90_nowrite, rcode) 30 30 varid1 = nf90_inq_varid(ncid1, 'EMISSION', rcode) -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_surface.F90
r5110 r5116 39 39 real, dimension(jjp1) :: lats 40 40 real, dimension(nbp_lat) :: lats_glo 41 real:: rcode241 REAL :: rcode2 42 42 integer, dimension(1) :: startj,endj 43 43 !JE20140526>> … … 83 83 84 84 DO i=1,5 85 write(str1,'(i1)') i85 WRITE(str1,'(i1)') i 86 86 varname=trim(name)//str1 87 87 PRINT*,'lecture variable:',varname … … 118 118 !JE20140526<< 119 119 ! CALL gr_dyn_fi(1, iip1, jjp1, klon, tmp_dyn_invers, tmp_fi) 120 if (isinversed) then120 if (isinversed) THEN 121 121 CALL gr_dyn_fi(1, nbp_lon+1, nbp_lat, klon_glo, & 122 122 tmp_dyn_invers_glo, tmp_fi_glo) -
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_vent.f90
r5110 r5116 10 10 INTEGER :: step, nbjour 11 11 LOGICAL :: debutphy 12 real:: u10m_ec(klon), v10m_ec(klon)13 real:: u10m_ec_glo(klon_glo), v10m_ec_glo(klon_glo)12 REAL :: u10m_ec(klon), v10m_ec(klon) 13 REAL :: u10m_ec_glo(klon_glo), v10m_ec_glo(klon_glo) 14 14 15 15 ! real u10m_nc(iip1,jjp1) !, v10m_nc(iip1,jjm) ! dim 97x72 16 16 ! real v10m_nc(iip1,jjp1) ! dim 97x73 17 real:: u10m_nc_glo(nbp_lon + 1, nbp_lat) !, v10m_nc(iip1,jjm) ! dim 97x7218 real:: v10m_nc_glo(nbp_lon + 1, nbp_lat) ! dim 97x7319 integer:: rcode20 integer:: ncidu1, varidu1, ncidv1, varidv117 REAL :: u10m_nc_glo(nbp_lon + 1, nbp_lat) !, v10m_nc(iip1,jjm) ! dim 97x72 18 REAL :: v10m_nc_glo(nbp_lon + 1, nbp_lat) ! dim 97x73 19 INTEGER :: rcode 20 INTEGER :: ncidu1, varidu1, ncidv1, varidv1 21 21 save ncidu1, varidu1, ncidv1, varidv1 22 22 !$OMP THREADPRIVATE(ncidu1, varidu1, ncidv1, varidv1) 23 integer:: start(4), count(4), status24 integer:: i, j, ig23 INTEGER :: start(4), count(4), status 24 INTEGER :: i, j, ig 25 25 26 26 !$OMP MASTER 27 27 IF (is_mpi_root .AND. is_omp_root) THEN 28 if (debutphy) then 29 28 if (debutphy) THEN 30 29 ncidu1 = nf90_open('u10m.nc', nf90_nowrite, rcode) 31 30 varidu1 = nf90_inq_varid(ncidu1, 'U10M', rcode) … … 107 106 ! added by JE from the nh SPLA, dyn3d/read_reanalyse.F which is not available any more 108 107 SUBROUTINE correctbid(iim, nl, x) 109 integer:: iim, nl110 real:: x(iim + 1, nl)111 integer:: i, l112 real:: zz108 INTEGER :: iim, nl 109 REAL :: x(iim + 1, nl) 110 INTEGER :: i, l 111 REAL :: zz 113 112 114 113 do l = 1, nl 115 114 do i = 2, iim - 1 116 if(abs(x(i, l))>1.e10) then115 IF(abs(x(i, l))>1.e10) THEN 117 116 zz = 0.5 * (x(i - 1, l) + x(i + 1, l)) 118 117 ! PRINT*,'correction ',i,l,x(i,l),zz
Note: See TracChangeset
for help on using the changeset viewer.
