Changeset 2133 for trunk/LMDZ.TITAN/libf/phytitan
- Timestamp:
- Apr 30, 2019, 10:34:11 AM (6 years ago)
- Location:
- trunk/LMDZ.TITAN/libf/phytitan
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.TITAN/libf/phytitan/callcorrk.F90
r2050 r2133 6 6 fluxabs_sw,fluxtop_dn, & 7 7 OLR_nu,OSR_nu, & 8 int_dtaui,int_dtauv, & 8 9 lastcall) 9 10 … … 16 17 use comcstfi_mod, only: pi, mugaz, cpp 17 18 use callkeys_mod, only: diurnal,tracer,seashaze,corrk_recombin, & 18 strictboundcorrk,specOLR 19 strictboundcorrk,specOLR,diagdtau 19 20 use geometry_mod, only: latitude 20 21 … … 74 75 REAL,INTENT(OUT) :: OSR_nu(ngrid,L_NSPECTV) ! Outgoing SW radition in each band (Normalized to the band width (W/m2/cm-1). 75 76 REAL,INTENT(OUT) :: albedo_equivalent(ngrid) ! Spectrally Integrated Albedo. For Diagnostic. By MT2015 77 REAL,INTENT(OUT) :: int_dtaui(ngrid,nlayer,L_NSPECTI) ! VI optical thickness of layers within narrowbands for diags (). 78 REAL,INTENT(OUT) :: int_dtauv(ngrid,nlayer,L_NSPECTV) ! IR optical thickness of layers within narrowbands for diags (). 76 79 77 80 … … 534 537 535 538 539 ! Optical thickness diagnostics (added by JVO) 540 if (diagdtau) then 541 do l=1,L_NLAYRAD 542 do nw=1,L_NSPECTV 543 int_dtauv(ig,l,nw) = 0.0d0 544 DO k=1,L_NGAUSS 545 int_dtauv(ig,l,nw)= int_dtauv(ig,l,nw) + dtauv(l,nw,k)*gweight(k) 546 ENDDO 547 enddo 548 do nw=1,L_NSPECTI 549 int_dtaui(ig,l,nw) = 0.0d0 550 DO k=1,L_NGAUSS 551 int_dtaui(ig,l,nw)= int_dtaui(ig,l,nw) + dtaui(l,nw,k)*gweight(k) 552 ENDDO 553 enddo 554 enddo 555 endif 556 557 536 558 !----------------------------------------------------------------------- 537 559 end do ! End of big loop over every GCM column. 538 560 !----------------------------------------------------------------------- 539 540 561 541 562 -
trunk/LMDZ.TITAN/libf/phytitan/inifis_mod.F90
r2131 r2133 341 341 call getin_p("diagdtau",diagdtau) 342 342 write(*,*)" diagdtau = ",diagdtau 343 ! sanity check344 if (diagdtau.and.(ngrid.ne.1)) then345 print*,"Diagnostic optical thickness can be output in 1D only !"346 print*,"Start again with diagdtau=.false."347 stop348 endif349 350 343 351 344 write(*,*)"Uniform absorption in radiative transfer?" -
trunk/LMDZ.TITAN/libf/phytitan/optci.F90
r2131 r2133 4 4 use radinc_h 5 5 use radcommon_h, only: gasi,gasi_recomb,tlimit,Cmk,gzlat_ig, & 6 tgasref,pfgasref,wnoi,scalep,indi ,gweight6 tgasref,pfgasref,wnoi,scalep,indi 7 7 use gases_h 8 8 use comcstfi_mod, only: r 9 use callkeys_mod, only: continuum,graybody,corrk_recombin, diagdtau,&9 use callkeys_mod, only: continuum,graybody,corrk_recombin, & 10 10 callclouds,callmufi,seashaze,uncoupl_optic_haze 11 11 use tracer_h, only : nmicro,nice 12 use MMP_OPTICS 12 13 13 14 implicit none … … 59 60 real*8 SSA_T(L_LEVELS,L_NSPECTI) 60 61 real*8 ASF_T(L_LEVELS,L_NSPECTI) 61 real*8 INT_DTAU(L_NLAYRAD,L_NSPECTI)62 63 CHARACTER*2 str264 62 ! ========================== 65 63 … … 409 407 ! ascending ray with angle theta = 0. 410 408 411 412 ! Optical thickness for 1D diagnostics (added by JVO)413 if (diagdtau) then ! diagtau can be true only if 1D414 do l=1,L_NLAYRAD415 do nw=1,L_NSPECTI416 INT_DTAU(L,NW) = 0.0d+0417 DO NG=1,L_NGAUSS418 INT_DTAU(L,NW)= INT_DTAU(L,NW) + dtaui(L,nw,ng)*gweight(NG)419 enddo420 enddo421 enddo422 do nw=1,L_NSPECTI423 write(str2,'(i2.2)') nw424 call writediagfi(1,'dtaui'//str2,'Layer optical thickness in IR band '//str2,'',1,int_dtau(L_NLAYRAD:1:-1,nw))425 enddo426 endif427 428 429 409 if(firstcall) firstcall = .false. 430 410 -
trunk/LMDZ.TITAN/libf/phytitan/optcv.F90
r2131 r2133 4 4 use radinc_h 5 5 use radcommon_h, only: gasv,gasv_recomb,tlimit,Cmk,gzlat_ig, & 6 tgasref,pfgasref,wnov,scalep,indv ,gweight6 tgasref,pfgasref,wnov,scalep,indv 7 7 use gases_h 8 8 use comcstfi_mod, only: r 9 use callkeys_mod, only: continuum,graybody,callgasvis,corrk_recombin, diagdtau,&9 use callkeys_mod, only: continuum,graybody,callgasvis,corrk_recombin, & 10 10 callclouds,callmufi,seashaze,uncoupl_optic_haze 11 11 use tracer_h, only: nmicro,nice … … 68 68 real*8 SSA_T(L_LEVELS,L_NSPECTI) 69 69 real*8 ASF_T(L_LEVELS,L_NSPECTI) 70 real*8 INT_DTAU(L_NLAYRAD,L_NSPECTI)71 72 CHARACTER*2 str273 70 ! ========================== 74 71 … … 390 387 391 388 392 ! Optical thickness for 1D diagnostics (added by JVO)393 if (diagdtau) then ! diagtau can be true only if 1D394 do l=1,L_NLAYRAD395 do nw=1,L_NSPECTV396 INT_DTAU(L,NW) = 0.0d+0397 DO NG=1,L_NGAUSS398 INT_DTAU(L,NW)= INT_DTAU(L,NW) + dtauv(L,nw,ng)*gweight(NG)399 enddo400 enddo401 enddo402 do nw=1,L_NSPECTV403 write(str2,'(i2.2)') nw404 call writediagfi(1,'dtauv'//str2,'Layer optical thickness in VI band '//str2,'',1,int_dtau(L_NLAYRAD:1:-1,nw))405 enddo406 endif407 408 409 389 if(firstcall) firstcall = .false. 410 390 -
trunk/LMDZ.TITAN/libf/phytitan/physiq_mod.F90
r2117 r2133 252 252 real,dimension(:,:),allocatable,save :: zdtsw ! SW heating tendencies (K/s). 253 253 real,dimension(:),allocatable,save :: sensibFlux ! Turbulent flux given by the atmosphere to the surface (W.m-2). 254 255 !$OMP THREADPRIVATE(fluxsurf_lw,fluxsurf_sw,fluxsurfabs_sw,fluxtop_lw,fluxabs_sw,fluxtop_dn,fluxdyn,OLR_nu,OSR_nu,& 256 257 !$OMP zdtlw,zdtsw,sensibFlux) 254 real,dimension(:,:,:),allocatable,save :: int_dtauv ! VI optical thickness of layers within narrowbands for diags (). 255 real,dimension(:,:,:),allocatable,save :: int_dtaui ! IR optical thickness of layers within narrowbands for diags (). 256 257 !$OMP THREADPRIVATE(fluxsurf_lw,fluxsurf_sw,fluxsurfabs_sw,fluxtop_lw,fluxabs_sw,fluxtop_dn,fluxdyn,OLR_nu,OSR_nu,& 258 !$OMP zdtlw,zdtsw,sensibFlux,int_dtauv,int_dtaui)) 258 259 259 260 real zls ! Solar longitude (radians). … … 368 369 character(len=10) :: tmp1 369 370 character(len=10) :: tmp2 371 372 character*2 :: str2 370 373 371 374 ! Local variables for Titan chemistry and microphysics … … 468 471 ALLOCATE(zdtlw(ngrid,nlayer)) 469 472 ALLOCATE(zdtsw(ngrid,nlayer)) 473 ALLOCATE(int_dtaui(ngrid,nlayer,L_NSPECTI)) 474 ALLOCATE(int_dtauv(ngrid,nlayer,L_NSPECTV)) 470 475 471 476 ! This is defined in comsaison_h … … 501 506 call sugas_corrk ! Set up gaseous absorption properties. 502 507 503 OLR_nu(:,:) = 0. 504 OSR_nu(:,:) = 0. 508 OLR_nu(:,:) = 0.D0 509 OSR_nu(:,:) = 0.D0 510 511 int_dtaui(:,:,:) = 0.D0 512 int_dtauv(:,:,:) = 0.D0 505 513 506 514 endif … … 855 863 fluxsurfabs_sw,fluxtop_lw, & 856 864 fluxabs_sw,fluxtop_dn,OLR_nu,OSR_nu, & 857 lastcall)865 int_dtaui,int_dtauv,lastcall) 858 866 859 867 ! Radiative flux from the sky absorbed by the surface (W.m-2). … … 1509 1517 1510 1518 endif ! end of 'enertest' 1519 1520 ! Diagnostics of optical thickness 1521 if (diagdtau) then 1522 do nw=1,L_NSPECTV 1523 write(str2,'(i2.2)') nw 1524 call writediagfi(ngrid,'dtauv'//str2,'Layer optical thickness in VI band '//str2,'',1,int_dtauv(:,nlayer:1:-1,nw)) 1525 enddo 1526 do nw=1,L_NSPECTI 1527 write(str2,'(i2.2)') nw 1528 call writediagfi(ngrid,'dtaui'//str2,'Layer optical thickness in IR band '//str2,'',1,int_dtaui(:,nlayer:1:-1,nw)) 1529 enddo 1530 endif 1511 1531 1512 1532 ! Temporary inclusions for winds diagnostics. -
trunk/LMDZ.TITAN/libf/phytitan/radcommon_h.F90
r2050 r2133 1 1 module radcommon_h 2 use radinc_h, only: L_NSPECTI, L_NSPECTV, L_NGAUSS,NTstar, NTstop2 use radinc_h, only: L_NSPECTI, L_NSPECTV, NTstar, NTstop 3 3 implicit none 4 4 … … 81 81 82 82 real*8,save :: PTOP 83 real*8,save,allocatable :: TAUREF(:)83 !$OMP THREADPRIVATE(tstellar,planckir,PTOP) 84 84 85 85 real*8,parameter :: UBARI = 0.5D0 86 87 !$OMP THREADPRIVATE(QREFvis,QREFir,omegaREFvis,omegaREFir,&88 !$OMP tstellar,planckir,PTOP)89 86 90 87 ! If the gas optical depth (top to the surface) is less than
Note: See TracChangeset
for help on using the changeset viewer.