Changeset 3798 for LMDZ6/branches/Ocean_skin/libf/phylmd/radlwsw_m.F90
- Timestamp:
- Jan 11, 2021, 11:24:08 PM (3 years ago)
- Location:
- LMDZ6/branches/Ocean_skin
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/radlwsw_m.F90 (modified) (30 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Ocean_skin
-
LMDZ6/branches/Ocean_skin/libf/phylmd/radlwsw_m.F90
r3605 r3798 21 21 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB pour RRTM 22 22 tau_aero_lw_rrtm, & ! rajoute par C. Kleinschmitt pour RRTM 23 cldtaupi, new_aod,&23 cldtaupi, & 24 24 qsat, flwc, fiwc, & 25 25 ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, & 26 26 heat,heat0,cool,cool0,albpla,& 27 27 heat_volc, cool_volc,& 28 topsw,toplw,solsw,sol lw,&28 topsw,toplw,solsw,solswfdiff,sollw,& 29 29 sollwdown,& 30 30 topsw0,toplw0,solsw0,sollw0,& … … 117 117 ! toplw----output-R- ray. IR montant au sommet de l'atmosphere 118 118 ! solsw----output-R- flux solaire net a la surface 119 ! solswfdiff----output-R- fraction de rayonnement diffus pour le flux solaire descendant a la surface 119 120 ! sollw----output-R- ray. IR montant a la surface 120 121 ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir) … … 188 189 REAL, INTENT(in) :: tsol(KLON) 189 190 REAL, INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW) 190 real, intent(in) :: SFRWL(6)191 REAL, INTENT(in) :: SFRWL(6) 191 192 !albedo SB <<< 192 193 REAL, INTENT(in) :: t(KLON,KLEV), q(KLON,KLEV) … … 222 223 223 224 REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations 224 LOGICAL, INTENT(in) :: new_aod ! flag pour retrouver les resultats exacts de l'AR4 dans le cas ou l'on ne travaille qu'avec les sulfates225 225 REAL, INTENT(in) :: qsat(klon,klev) ! Variable pour iflag_rrtm=1 226 226 REAL, INTENT(in) :: flwc(klon,klev) ! Variable pour iflag_rrtm=1 … … 236 236 REAL, INTENT(out) :: heat_volc(KLON,KLEV), cool_volc(KLON,KLEV) !NL 237 237 REAL, INTENT(out) :: topsw(KLON), toplw(KLON) 238 REAL, INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON) 238 REAL, INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON), solswfdiff(KLON) 239 239 REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON) 240 240 REAL, INTENT(out) :: sollwdown(KLON) … … 287 287 REAL(KIND=8) PWV(kdlon,kflev), PQS(kdlon,kflev) 288 288 289 real(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone289 REAL(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone 290 290 ! "POZON(:, :, 1)" is for the average day-night field, 291 291 ! "POZON(:, :, 2)" is for daylight time. … … 303 303 REAL(KIND=8) zheat_volc(kdlon,kflev), zcool_volc(kdlon,kflev) !NL 304 304 REAL(KIND=8) ztopsw(kdlon), ztoplw(kdlon) 305 REAL(KIND=8) zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon) 305 REAL(KIND=8) zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon), zsolswfdiff(kdlon) 306 306 REAL(KIND=8) zsollwdown(kdlon) 307 307 REAL(KIND=8) ztopsw0(kdlon), ztoplw0(kdlon) … … 330 330 !MPL input supplementaires pour RECMWFL 331 331 ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg) 332 332 REAL(KIND=8) GEMU(klon) 333 333 !MPL input RECMWFL: 334 334 ! Tableaux aux niveaux inverses pour respecter convention Arpege 335 336 335 REAL(KIND=8) ref_liq_i(klon,klev) ! cloud droplet radius present-day from newmicro (inverted) 336 REAL(KIND=8) ref_ice_i(klon,klev) ! ice crystal radius present-day from newmicro (inverted) 337 337 !--OB 338 339 338 REAL(KIND=8) ref_liq_pi_i(klon,klev) ! cloud droplet radius pre-industrial from newmicro (inverted) 339 REAL(KIND=8) ref_ice_pi_i(klon,klev) ! ice crystal radius pre-industrial from newmicro (inverted) 340 340 !--end OB 341 342 343 344 341 REAL(KIND=8) paprs_i(klon,klev+1) 342 REAL(KIND=8) pplay_i(klon,klev) 343 REAL(KIND=8) cldfra_i(klon,klev) 344 REAL(KIND=8) POZON_i(kdlon,kflev, size(wo, 3)) ! mass fraction of ozone 345 345 ! "POZON(:, :, 1)" is for the average day-night field, 346 346 ! "POZON(:, :, 2)" is for daylight time. 347 347 !!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 348 349 350 351 348 REAL(KIND=8) PAER_i(kdlon,kflev,6) 349 REAL(KIND=8) PDP_i(klon,klev) 350 REAL(KIND=8) t_i(klon,klev),q_i(klon,klev),qsat_i(klon,klev) 351 REAL(KIND=8) flwc_i(klon,klev),fiwc_i(klon,klev) 352 352 !MPL output RECMWFL: 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 353 REAL(KIND=8) ZEMTD (klon,klev+1),ZEMTD_i (klon,klev+1) 354 REAL(KIND=8) ZEMTU (klon,klev+1),ZEMTU_i (klon,klev+1) 355 REAL(KIND=8) ZTRSO (klon,klev+1),ZTRSO_i (klon,klev+1) 356 REAL(KIND=8) ZTH (klon,klev+1),ZTH_i (klon,klev+1) 357 REAL(KIND=8) ZCTRSO(klon,2) 358 REAL(KIND=8) ZCEMTR(klon,2) 359 REAL(KIND=8) ZTRSOD(klon) 360 REAL(KIND=8) ZLWFC (klon,2) 361 REAL(KIND=8) ZLWFT (klon,klev+1),ZLWFT_i (klon,klev+1) 362 REAL(KIND=8) ZSWFC (klon,2) 363 REAL(KIND=8) ZSWFT (klon,klev+1),ZSWFT_i (klon,klev+1) 364 REAL(KIND=8) ZFLUCDWN_i(klon,klev+1),ZFLUCUP_i(klon,klev+1) 365 REAL(KIND=8) PPIZA_TOT(klon,klev,NSW) 366 REAL(KIND=8) PCGA_TOT(klon,klev,NSW) 367 REAL(KIND=8) PTAU_TOT(klon,klev,NSW) 368 REAL(KIND=8) PPIZA_NAT(klon,klev,NSW) 369 REAL(KIND=8) PCGA_NAT(klon,klev,NSW) 370 REAL(KIND=8) PTAU_NAT(klon,klev,NSW) 371 371 #ifdef CPP_RRTM 372 373 372 REAL(KIND=8) PTAU_LW_TOT(klon,klev,NLW) 373 REAL(KIND=8) PTAU_LW_NAT(klon,klev,NLW) 374 374 #endif 375 376 377 378 375 REAL(KIND=8) PSFSWDIR(klon,NSW) 376 REAL(KIND=8) PSFSWDIF(klon,NSW) 377 REAL(KIND=8) PFSDNN(klon) 378 REAL(KIND=8) PFSDNV(klon) 379 379 !MPL On ne redefinit pas les tableaux ZFLUX,ZFLUC, 380 380 !MPL ZFSDWN,ZFCDWN,ZFSUP,ZFCUP car ils existent deja 381 381 !MPL sous les noms de ZFLDN,ZFLDN0,ZFLUP,ZFLUP0, 382 382 !MPL ZFSDN,ZFSDN0,ZFSUP,ZFSUP0 383 384 385 386 387 388 389 390 391 392 383 REAL(KIND=8) ZFLUX_i (klon,2,klev+1) 384 REAL(KIND=8) ZFLUC_i (klon,2,klev+1) 385 REAL(KIND=8) ZFSDWN_i (klon,klev+1) 386 REAL(KIND=8) ZFCDWN_i (klon,klev+1) 387 REAL(KIND=8) ZFCCDWN_i (klon,klev+1) 388 REAL(KIND=8) ZFSUP_i (klon,klev+1) 389 REAL(KIND=8) ZFCUP_i (klon,klev+1) 390 REAL(KIND=8) ZFCCUP_i (klon,klev+1) 391 REAL(KIND=8) ZFLCCDWN_i (klon,klev+1) 392 REAL(KIND=8) ZFLCCUP_i (klon,klev+1) 393 393 ! 3 lignes suivantes a activer pour CCMVAL (MPL 20100412) 394 394 ! REAL(KIND=8) RSUN(3,2) 395 395 ! REAL(KIND=8) SUN(3) 396 396 ! REAL(KIND=8) SUN_FRACT(2) 397 real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2397 REAL, PARAMETER:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2 398 398 CHARACTER (LEN=80) :: abort_message 399 399 CHARACTER (LEN=80) :: modname='radlwsw_m' 400 400 401 call assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo") 401 REAL zdir, zdif 402 403 CALL assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo") 402 404 ! initialisation 403 405 ist=1 … … 415 417 zsolsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4 416 418 417 418 ZTOPSWADAERO(:) = 0. !ym missing init 419 ZSOLSWADAERO(:) = 0. !ym missing init 420 ZTOPSWAD0AERO(:) = 0. !ym missing init 421 ZSOLSWAD0AERO(:) = 0. !ym missing init 422 ZTOPSWAIAERO(:) = 0. !ym missing init 423 ZSOLSWAIAERO(:) = 0. !ym missing init 424 ZTOPSWCF_AERO(:,:)= 0.!ym missing init 425 ZSOLSWCF_AERO(:,:) =0. !ym missing init 419 ZTOPSWADAERO(:) = 0. !ym missing init 420 ZSOLSWADAERO(:) = 0. !ym missing init 421 ZTOPSWAD0AERO(:) = 0. !ym missing init 422 ZSOLSWAD0AERO(:) = 0. !ym missing init 423 ZTOPSWAIAERO(:) = 0. !ym missing init 424 ZSOLSWAIAERO(:) = 0. !ym missing init 425 ZTOPSWCF_AERO(:,:)= 0.!ym missing init 426 ZSOLSWCF_AERO(:,:) =0. !ym missing init 426 427 427 428 ! … … 454 455 IF (type_trac == 'repr') THEN 455 456 #ifdef REPROBUS 456 if(ok_SUNTIME) PSCT = solaireTIME/zdist/zdist 457 print*,'Constante solaire: ',PSCT*zdist*zdist 457 IF (iflag_rrtm==0) THEN 458 IF (ok_SUNTIME) PSCT = solaireTIME/zdist/zdist 459 print*,'Constante solaire: ',PSCT*zdist*zdist 460 ENDIF 458 461 #endif 459 END 462 ENDIF 460 463 461 464 DO j = 1, nb_gr … … 540 543 CALL RAD_INTERACTIF(POZON,iof) 541 544 #endif 542 END IF 543 545 ENDIF 544 546 ! 545 547 DO k = 1, kflev+1 … … 567 569 ENDDO 568 570 ENDDO 569 570 571 ! 571 572 !===== iflag_rrtm ================================================ 572 573 ! 573 574 IF (iflag_rrtm == 0) THEN !!!! remettre 0 juste pour tester l'ancien rayt via rrtm 575 ! 574 576 !--- Mise a zero des tableaux output du rayonnement LW-AR4 ---------- 575 577 DO k = 1, kflev+1 … … 650 652 zsolswaiaero(i)=0. 651 653 ENDDO 654 655 !--fraction of diffuse radiation in surface SW downward radiation 656 !--not computed with old radiation scheme 657 zsolswfdiff(:) = -999.999 658 652 659 ! print *,'Avant SW_LMDAR4: PSCT zrmu0 zfract',PSCT, zrmu0, zfract 653 660 ! daylight ozone, if we have it, for short wave 654 IF (.NOT. new_aod) THEN 655 ! use old version 656 CALL SW_LMDAR4(PSCT, zrmu0, zfract,& 657 PPMB, PDP, & 658 PPSOL, PALBD, PALBP,& 659 PTAVE, PWV, PQS, POZON(:, :, size(wo, 3)), PAER,& 660 PCLDSW, PTAU, POMEGA, PCG,& 661 zheat, zheat0,& 662 zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,& 663 ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,& 664 tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),& 665 PTAUA, POMEGAA,& 666 ztopswadaero,zsolswadaero,& 667 ztopswaiaero,zsolswaiaero,& 668 ok_ade, ok_aie) 669 670 ELSE ! new_aod=T 671 CALL SW_AEROAR4(PSCT, zrmu0, zfract,& 661 CALL SW_AEROAR4(PSCT, zrmu0, zfract,& 672 662 PPMB, PDP,& 673 663 PPSOL, PALBD, PALBP,& … … 686 676 ztopswcf_aero,zsolswcf_aero, & 687 677 ok_ade, ok_aie, flag_aerosol,flag_aerosol_strat) 688 ENDIF689 678 690 679 ZSWFT0_i(:,:) = ZFSDN0(:,:)-ZFSUP0(:,:) … … 693 682 DO i=1,kdlon 694 683 DO k=1,kflev+1 695 ! print *,'iof i k klon klev=',iof,i,k,klon,klev696 684 lwdn0 ( iof+i,k) = ZFLDN0 ( i,k) 697 685 lwdn ( iof+i,k) = ZFLDN ( i,k) … … 704 692 ENDDO 705 693 ENDDO 706 ! print*,'SW_AR4 ZFSDN0 1 , klev:',ZFSDN0(1:klon,1),ZFSDN0(1:klon,klev) 707 ! print*,'SW_AR4 swdn0 1 , klev:',swdn0(1:klon,1),swdn0(1:klon,klev) 708 ! print*,'SW_AR4 ZFSUP0 1 , klev:',ZFSUP0(1:klon,1),ZFSUP0(1:klon,klev) 709 ! print*,'SW_AR4 swup0 1 , klev:',swup0(1:klon,1),swup0(1:klon,klev) 710 ! print*,'SW_AR4 ZFSDN 1 , klev:',ZFSDN(1:klon,1) ,ZFSDN(1:klon,klev) 711 ! print*,'SW_AR4 ZFSUP 1 , klev:',ZFSUP(1:klon,1) ,ZFSUP(1:klon,klev) 694 ! 712 695 ELSE 713 696 #ifdef CPP_RRTM … … 717 700 DO k = 1, kflev+1 718 701 DO i = 1, kdlon 719 ZEMTD_i(i,k)=0.720 ZEMTU_i(i,k)=0.721 ZTRSO_i(i,k)=0.722 ZTH_i(i,k)=0.723 ZLWFT_i(i,k)=0.724 ZSWFT_i(i,k)=0.725 ZFLUX_i(i,1,k)=0.726 ZFLUX_i(i,2,k)=0.727 ZFLUC_i(i,1,k)=0.728 ZFLUC_i(i,2,k)=0.729 ZFSDWN_i(i,k)=0.730 ZFCDWN_i(i,k)=0.731 ZFCCDWN_i(i,k)=0.732 ZFSUP_i(i,k)=0.733 ZFCUP_i(i,k)=0.734 ZFCCUP_i(i,k)=0.735 ZFLCCDWN_i(i,k)=0.736 ZFLCCUP_i(i,k)=0.702 ZEMTD_i(i,k)=0. 703 ZEMTU_i(i,k)=0. 704 ZTRSO_i(i,k)=0. 705 ZTH_i(i,k)=0. 706 ZLWFT_i(i,k)=0. 707 ZSWFT_i(i,k)=0. 708 ZFLUX_i(i,1,k)=0. 709 ZFLUX_i(i,2,k)=0. 710 ZFLUC_i(i,1,k)=0. 711 ZFLUC_i(i,2,k)=0. 712 ZFSDWN_i(i,k)=0. 713 ZFCDWN_i(i,k)=0. 714 ZFCCDWN_i(i,k)=0. 715 ZFSUP_i(i,k)=0. 716 ZFCUP_i(i,k)=0. 717 ZFCCUP_i(i,k)=0. 718 ZFLCCDWN_i(i,k)=0. 719 ZFLCCUP_i(i,k)=0. 737 720 ENDDO 738 721 ENDDO … … 788 771 PFSDNV(i)=0. 789 772 DO kk = 1, NSW 790 PSFSWDIR(i,kk)=0.791 PSFSWDIF(i,kk)=0.773 PSFSWDIR(i,kk)=0. 774 PSFSWDIF(i,kk)=0. 792 775 ENDDO 793 776 ENDDO … … 796 779 ! On met les donnees dans l'ordre des niveaux arpege 797 780 paprs_i(:,1)=paprs(:,klev+1) 798 dok=1,klev781 DO k=1,klev 799 782 paprs_i(1:klon,k+1) =paprs(1:klon,klev+1-k) 800 783 pplay_i(1:klon,k) =pplay(1:klon,klev+1-k) … … 811 794 ref_liq_pi_i(1:klon,k) =ref_liq_pi(1:klon,klev+1-k) 812 795 ref_ice_pi_i(1:klon,k) =ref_ice_pi(1:klon,klev+1-k) 813 enddo814 dok=1,kflev796 ENDDO 797 DO k=1,kflev 815 798 POZON_i(1:klon,k,:)=POZON(1:klon,kflev+1-k,:) 816 799 !!! POZON_i(1:klon,k)=POZON(1:klon,k) !!! on laisse 1=sol et klev=top 817 800 ! print *,'Juste avant RECMWFL: k tsol temp',k,tsol,t(1,k) 818 801 !!!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 819 doi=1,6802 DO i=1,6 820 803 PAER_i(1:klon,k,i)=PAER(1:klon,kflev+1-k,i) 821 enddo822 enddo804 ENDDO 805 ENDDO 823 806 ! print *,'RADLWSW: avant RECMWFL, RI0,rmu0=',solaire,rmu0 824 807 … … 849 832 ! s 'RECMWF ') 850 833 ! 851 if(lldebug) then834 IF (lldebug) THEN 852 835 CALL writefield_phy('paprs_i',paprs_i,klev+1) 853 836 CALL writefield_phy('pplay_i',pplay_i,klev) … … 863 846 CALL writefield_phy('palbd_new',PALBD_NEW,NSW) 864 847 CALL writefield_phy('palbp_new',PALBP_NEW,NSW) 865 endif848 ENDIF 866 849 867 850 ! Nouvel appel a RECMWF (celui du cy32t0) … … 893 876 894 877 ! print *,'RADLWSW: apres RECMWF' 895 if(lldebug) then878 IF (lldebug) THEN 896 879 CALL writefield_phy('zemtd_i',ZEMTD_i,klev+1) 897 880 CALL writefield_phy('zemtu_i',ZEMTU_i,klev+1) … … 918 901 CALL writefield_phy('zfcdwn_i',ZFCDWN_i,klev+1) 919 902 CALL writefield_phy('zfcup_i',ZFCUP_i,klev+1) 920 endif903 ENDIF 921 904 ! --------- output RECMWFL 922 905 ! ZEMTD (KPROMA,KLEV+1) ; TOTAL DOWNWARD LONGWAVE EMISSIVITY … … 969 952 ZFLDNC0(i,k+1)= ZFLCCDWN_i(i,k+1) 970 953 ZFLUPC0(i,k+1)= ZFLCCUP_i(i,k+1) 971 IF (ok_volcan) THEN954 IF (ok_volcan) THEN 972 955 ZSWADAERO(i,k+1)=ZSWADAERO(i,k+1)*fract(i) !--NL 973 956 ENDIF … … 1009 992 ! On renseigne les champs LMDz, pour avoir la meme chose qu'en sortie de 1010 993 ! LW_LMDAR4 et SW_LMDAR4 994 995 !--fraction of diffuse radiation in surface SW downward radiation 996 DO i = 1, kdlon 997 IF (fract(i).GT.0.0) THEN 998 zdir=SUM(PSFSWDIR(i,:)) 999 zdif=SUM(PSFSWDIF(i,:)) 1000 zsolswfdiff(i) = zdif/(zdir+zdif) 1001 ELSE !--night 1002 zsolswfdiff(i) = 1.0 1003 ENDIF 1004 ENDDO 1005 ! 1011 1006 DO i = 1, kdlon 1012 1007 zsolsw(i) = ZSWFT(i,1) … … 1026 1021 ztoplw0(i) = ZLWFT0_i(i,klev+1)*(-1) 1027 1022 ! 1028 1023 IF (fract(i) == 0.) THEN 1029 1024 !!!!! A REVOIR MPL (20090630) ca n a pas de sens quand fract=0 1030 1025 ! pas plus que dans le sw_AR4 … … 1047 1042 ! ZLWFT(klon,k),ZSWFT 1048 1043 1049 dok=1,kflev1050 doi=1,kdlon1044 DO k=1,kflev 1045 DO i=1,kdlon 1051 1046 zheat(i,k)=(ZSWFT(i,k+1)-ZSWFT(i,k))*RDAY*RG/RCPD/PDP(i,k) 1052 1047 zheat0(i,k)=(ZSWFT0_i(i,k+1)-ZSWFT0_i(i,k))*RDAY*RG/RCPD/PDP(i,k) 1053 1048 zcool(i,k)=(ZLWFT(i,k)-ZLWFT(i,k+1))*RDAY*RG/RCPD/PDP(i,k) 1054 1049 zcool0(i,k)=(ZLWFT0_i(i,k)-ZLWFT0_i(i,k+1))*RDAY*RG/RCPD/PDP(i,k) 1055 IF (ok_volcan) THEN1050 IF (ok_volcan) THEN 1056 1051 zheat_volc(i,k)=(ZSWADAERO(i,k+1)-ZSWADAERO(i,k))*RG/RCPD/PDP(i,k) !NL 1057 1052 zcool_volc(i,k)=(ZLWADAERO(i,k)-ZLWADAERO(i,k+1))*RG/RCPD/PDP(i,k) !NL … … 1060 1055 ! ZFLUCUP_i(i,k)=ZFLUC_i(i,1,k) 1061 1056 ! ZFLUCDWN_i(i,k)=ZFLUC_i(i,2,k) 1062 enddo1063 enddo1057 ENDDO 1058 ENDDO 1064 1059 #else 1065 1060 abort_message="You should compile with -rrtm if running with iflag_rrtm=1" … … 1073 1068 toplw(iof+i) = ztoplw(i) 1074 1069 solsw(iof+i) = zsolsw(i) 1070 solswfdiff(iof+i) = zsolswfdiff(i) 1075 1071 sollw(iof+i) = zsollw(i) 1076 1072 sollwdown(iof+i) = zsollwdown(i)
Note: See TracChangeset
for help on using the changeset viewer.
