Changeset 704 for LMDZ4/branches/V3_test/libf/phylmd/radlwsw.F
- Timestamp:
- Aug 17, 2006, 5:41:51 PM (18 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/V3_test/libf/phylmd/radlwsw.F
r699 r704 16 16 . cldtaupi, topswai, solswai) 17 17 c 18 USE dimphy 18 19 IMPLICIT none 19 20 c====================================================================== … … 69 70 70 71 c====================================================================== 71 #include "dimensions.h"72 #include "dimphy.h"73 #include "raddim.h"72 cym#include "dimensions.h" 73 cym#include "dimphy.h" 74 cym#include "raddim.h" 74 75 #include "YOETHF.h" 75 76 c … … 403 404 S PTOPSWAD,PSOLSWAD,PTOPSWAI,PSOLSWAI, 404 405 J ok_ade, ok_aie ) 405 406 USE dimphy 406 407 IMPLICIT none 407 408 408 #include "dimensions.h"409 #include "dimphy.h"410 #include "raddim.h"409 cym#include "dimensions.h" 410 cym#include "dimphy.h" 411 cym#include "raddim.h" 411 412 #include "YOMCST.h" 412 413 C … … 509 510 DATA itapsw /0/ 510 511 DATA appel1er /.TRUE./ 512 SAVE itapsw,appel1er 513 c$OMP THREADPRIVATE(appel1er) 514 c$OMP THREADPRIVATE(itapsw) 511 515 cjq-Introduced for aerosol forcings 512 516 real*8 flag_aer … … 522 526 REAL*8 PSOLSWAI(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND) 523 527 cjq - Fluxes including aerosol effects 524 REAL*8 ZFSUPAD(KDLON,KFLEV+1) 525 REAL*8 ZFSDNAD(KDLON,KFLEV+1) 526 REAL*8 ZFSUPAI(KDLON,KFLEV+1) 527 REAL*8 ZFSDNAI(KDLON,KFLEV+1) 528 REAL*8,allocatable,save :: ZFSUPAD(:,:) 529 c$OMP THREADPRIVATE(ZFSUPAD) 530 REAL*8,allocatable,save :: ZFSDNAD(:,:) 531 c$OMP THREADPRIVATE(ZFSDNAD) 532 REAL*8,allocatable,save :: ZFSUPAI(:,:) 533 c$OMP THREADPRIVATE(ZFSUPAI) 534 REAL*8,allocatable,save :: ZFSDNAI(:,:) 535 c$OMP THREADPRIVATE(ZFSDNAI) 528 536 logical initialized 529 SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes537 cym SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes 530 538 !rv 531 539 save flag_aer 540 c$OMP THREADPRIVATE(flag_aer) 532 541 data initialized/.false./ 542 save initialized 543 c$OMP THREADPRIVATE(initialized) 533 544 cjq-end 534 545 if(.not.initialized) then 535 546 flag_aer=0. 536 547 initialized=.TRUE. 548 allocate(ZFSUPAD(KDLON,KFLEV+1)) 549 allocate(ZFSDNAD(KDLON,KFLEV+1)) 550 allocate(ZFSUPAI(KDLON,KFLEV+1)) 551 allocate(ZFSDNAI(KDLON,KFLEV+1)) 552 ZFSUPAD(:,:)=0. 553 ZFSDNAD(:,:)=0. 554 ZFSUPAI(:,:)=0. 555 ZFSDNAI(:,:)=0. 556 537 557 endif 538 558 !rv … … 710 730 S PTAVE,PWV,PAKI,PCLD,PCLEAR,PDSIG,PFACT, 711 731 S PRMU,PSEC,PUD) 732 USE dimphy 712 733 IMPLICIT none 713 #include "dimensions.h"714 #include "dimphy.h"715 #include "raddim.h"734 cym#include "dimensions.h" 735 cym#include "dimphy.h" 736 cym#include "raddim.h" 716 737 #include "radepsi.h" 717 738 #include "radopt.h" … … 761 782 REAL*8 ZPDH2O,ZPDUMG 762 783 SAVE ZPDH2O,ZPDUMG 784 c$OMP THREADPRIVATE(ZPDH2O,ZPDUMG) 763 785 REAL*8 ZPRH2O,ZPRUMG 764 786 SAVE ZPRH2O,ZPRUMG 787 c$OMP THREADPRIVATE(ZPRH2O,ZPRUMG) 765 788 REAL*8 RTDH2O,RTDUMG 766 789 SAVE RTDH2O,RTDUMG 790 c$OMP THREADPRIVATE(RTDH2O,RTDUMG) 767 791 REAL*8 RTH2O ,RTUMG 768 792 SAVE RTH2O ,RTUMG 793 c$OMP THREADPRIVATE(RTH2O ,RTUMG) 769 794 DATA ZPDH2O,ZPDUMG / 0.8 , 0.75 / 770 795 DATA ZPRH2O,ZPRUMG / 30000., 30000. / … … 900 925 S , PDSIG , POMEGA, POZ , PRMU , PSEC , PTAU , PUD 901 926 S , PFD , PFU) 927 USE dimphy 902 928 IMPLICIT none 903 #include "dimensions.h"904 #include "dimphy.h"905 #include "raddim.h"929 cym#include "dimensions.h" 930 cym#include "dimphy.h" 931 cym#include "raddim.h" 906 932 C 907 933 C ------------------------------------------------------------------ … … 991 1017 REAL*8 RSUN(2) 992 1018 SAVE RSUN 1019 c$OMP THREADPRIVATE(RSUN) 993 1020 REAL*8 RRAY(2,6) 994 1021 SAVE RRAY 1022 c$OMP THREADPRIVATE(RRAY) 995 1023 DATA RSUN(1) / 0.441676 / 996 1024 DATA RSUN(2) / 0.558324 / … … 1140 1168 S , PUD ,PWV , PQS 1141 1169 S , PFDOWN,PFUP ) 1170 USE dimphy 1142 1171 IMPLICIT none 1143 #include "dimensions.h"1144 #include "dimphy.h"1145 #include "raddim.h"1172 cym#include "dimensions.h" 1173 cym#include "dimphy.h" 1174 cym#include "raddim.h" 1146 1175 #include "radepsi.h" 1147 1176 C … … 1264 1293 REAL*8 RSUN(2) 1265 1294 SAVE RSUN 1295 c$OMP THREADPRIVATE(RSUN) 1266 1296 REAL*8 RRAY(2,6) 1267 1297 SAVE RRAY 1298 c$OMP THREADPRIVATE(RRAY) 1268 1299 DATA RSUN(1) / 0.441676 / 1269 1300 DATA RSUN(2) / 0.558324 / … … 1686 1717 S , PCGAZ , PPIZAZ, PRAY1 , PRAY2 , PREFZ , PRJ 1687 1718 S , PRK , PRMU0 , PTAUAZ, PTRA1 , PTRA2 ) 1719 USE dimphy 1688 1720 IMPLICIT none 1689 #include "dimensions.h"1690 #include "dimphy.h"1691 #include "raddim.h"1721 cym#include "dimensions.h" 1722 cym#include "dimphy.h" 1723 cym#include "raddim.h" 1692 1724 #include "radepsi.h" 1693 1725 #include "radopt.h" … … 1759 1791 REAL*8 TAUA(2,5), RPIZA(2,5), RCGA(2,5) 1760 1792 SAVE TAUA, RPIZA, RCGA 1793 c$OMP THREADPRIVATE(TAUA, RPIZA, RCGA) 1761 1794 DATA ((TAUA(IN,JA),JA=1,5),IN=1,2) / 1762 1795 S .730719, .912819, .725059, .745405, .682188 , … … 2046 2079 S , PCGAZ , PPIZAZ, PRAY1, PRAY2, PREFZ , PRJ , PRK , PRMUE 2047 2080 S , PTAUAZ, PTRA1 , PTRA2 ) 2081 USE dimphy 2048 2082 IMPLICIT none 2049 #include "dimensions.h"2050 #include "dimphy.h"2051 #include "raddim.h"2083 cym#include "dimensions.h" 2084 cym#include "dimphy.h" 2085 cym#include "raddim.h" 2052 2086 #include "radepsi.h" 2053 2087 #include "radopt.h" … … 2402 2436 SUBROUTINE SWDE (PGG,PREF,PRMUZ,PTO1,PW, 2403 2437 S PRE1,PRE2,PTR1,PTR2) 2438 USE dimphy 2404 2439 IMPLICIT none 2405 #include "dimensions.h"2406 #include "dimphy.h"2407 #include "raddim.h"2440 cym#include "dimensions.h" 2441 cym#include "dimphy.h" 2442 cym#include "raddim.h" 2408 2443 C 2409 2444 C ------------------------------------------------------------------ … … 2533 2568 END 2534 2569 SUBROUTINE SWTT (KNU,KA,PU,PTR) 2570 USE dimphy 2535 2571 IMPLICIT none 2536 #include "dimensions.h"2537 #include "dimphy.h"2538 #include "raddim.h"2572 cym#include "dimensions.h" 2573 cym#include "dimphy.h" 2574 cym#include "raddim.h" 2539 2575 C 2540 2576 C----------------------------------------------------------------------- … … 2583 2619 REAL*8 APAD(2,3,7), BPAD(2,3,7), D(2,3) 2584 2620 SAVE APAD, BPAD, D 2621 c$OMP THREADPRIVATE(APAD, BPAD, D) 2585 2622 DATA ((APAD(1,I,J),I=1,3),J=1,7) / 2586 2623 S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, … … 2649 2686 END 2650 2687 SUBROUTINE SWTT1(KNU,KABS,KIND, PU, PTR) 2688 USE dimphy 2651 2689 IMPLICIT none 2652 #include "dimensions.h"2653 #include "dimphy.h"2654 #include "raddim.h"2690 cym#include "dimensions.h" 2691 cym#include "dimphy.h" 2692 cym#include "raddim.h" 2655 2693 C 2656 2694 C----------------------------------------------------------------------- … … 2701 2739 REAL*8 APAD(2,3,7), BPAD(2,3,7), D(2,3) 2702 2740 SAVE APAD, BPAD, D 2741 c$OMP THREADPRIVATE(APAD, BPAD, D) 2703 2742 DATA ((APAD(1,I,J),I=1,3),J=1,7) / 2704 2743 S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, … … 2778 2817 . PTOPLW,PSOLLW,PTOPLW0,PSOLLW0, 2779 2818 . psollwdown, 2819 cIM . psollwdown,psollwdownclr, 2820 cIM . ptoplwdown,ptoplwdownclr) 2780 2821 . plwup, plwdn, plwup0, plwdn0) 2822 USE dimphy 2781 2823 IMPLICIT none 2782 #include "dimensions.h"2783 #include "dimphy.h"2784 #include "raddim.h"2824 cym#include "dimensions.h" 2825 cym#include "dimphy.h" 2826 cym#include "raddim.h" 2785 2827 #include "raddimlw.h" 2786 2828 #include "YOMCST.h" … … 2844 2886 c Rajout LF 2845 2887 real*8 psollwdown(kdlon) ! LONGWAVE downwards flux at surface 2888 c Rajout IM 2889 cIM real*8 psollwdownclr(kdlon) ! LONGWAVE CS downwards flux at surface 2890 cIM real*8 ptoplwdown(kdlon) ! LONGWAVE downwards flux at T.O.A. 2891 cIM real*8 ptoplwdownclr(kdlon) ! LONGWAVE CS downwards flux at T.O.A. 2846 2892 cIM 2847 2893 REAL*8 plwup(KDLON,KFLEV+1) ! LW up total sky … … 2853 2899 REAL*8 ZOZ(KDLON,KFLEV) 2854 2900 c 2855 REAL*8 ZFLUX(KDLON,2,KFLEV+1) ! RADIATIVE FLUXES (1:up; 2:down) 2856 REAL*8 ZFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES 2857 REAL*8 ZBINT(KDLON,KFLEV+1) ! Intermediate variable 2858 REAL*8 ZBSUI(KDLON) ! Intermediate variable 2859 REAL*8 ZCTS(KDLON,KFLEV) ! Intermediate variable 2860 REAL*8 ZCNTRB(KDLON,KFLEV+1,KFLEV+1) ! Intermediate variable 2861 SAVE ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB 2901 cym REAL*8 ZFLUX(KDLON,2,KFLEV+1) ! RADIATIVE FLUXES (1:up; 2:down) 2902 cym REAL*8 ZFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES 2903 cym REAL*8 ZBINT(KDLON,KFLEV+1) ! Intermediate variable 2904 cym REAL*8 ZBSUI(KDLON) ! Intermediate variable 2905 cym REAL*8,ZCTS(KDLON,KFLEV) ! Intermediate variable 2906 cym REAL*8 ZCNTRB(KDLON,KFLEV+1,KFLEV+1) ! Intermediate variable 2907 cym SAVE ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB 2908 REAL*8,allocatable,save :: ZFLUX(:,:,:) ! RADIATIVE FLUXES (1:up; 2:down) 2909 REAL*8,allocatable,save :: ZFLUC(:,:,:) ! CLEAR-SKY RADIATIVE FLUXES 2910 REAL*8,allocatable,save :: ZBINT(:,:) ! Intermediate variable 2911 REAL*8,allocatable,save :: ZBSUI(:) ! Intermediate variable 2912 REAL*8,allocatable,save :: ZCTS(:,:) ! Intermediate variable 2913 REAL*8,allocatable,save :: ZCNTRB(:,:,:) ! Intermediate variable 2914 c$OMP THREADPRIVATE(ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB) 2862 2915 c 2863 2916 INTEGER ilim, i, k, kpl1 … … 2871 2924 LOGICAL appel1er 2872 2925 SAVE appel1er, itaplw0, itaplw 2926 c$OMP THREADPRIVATE(appel1er, itaplw0, itaplw) 2873 2927 DATA appel1er /.TRUE./ 2874 2928 DATA itaplw0,itaplw /0,0/ 2929 2875 2930 C ------------------------------------------------------------------ 2876 2931 IF (appel1er) THEN … … 2878 2933 PRINT*, "LW cloudy-sky calling frequency: ", lwpas 2879 2934 PRINT*, " In general, they should be 1" 2935 cym 2936 allocate(ZFLUX(KDLON,2,KFLEV+1) ) 2937 allocate(ZFLUC(KDLON,2,KFLEV+1) ) 2938 allocate(ZBINT(KDLON,KFLEV+1)) 2939 allocate(ZBSUI(KDLON)) 2940 allocate(ZCTS(KDLON,KFLEV)) 2941 allocate(ZCNTRB(KDLON,KFLEV+1,KFLEV+1)) 2880 2942 appel1er=.FALSE. 2881 2943 ENDIF … … 2940 3002 S PAER,PDP,PPMB,PPSOL,POZ,PTAVE,PVIEW,PWV, 2941 3003 S PABCU) 3004 USE dimphy 2942 3005 IMPLICIT none 2943 #include "dimensions.h"2944 #include "dimphy.h"2945 #include "raddim.h"3006 cym#include "dimensions.h" 3007 cym#include "dimphy.h" 3008 cym#include "raddim.h" 2946 3009 #include "raddimlw.h" 2947 3010 #include "YOMCST.h" … … 3038 3101 REAL*8 TREF 3039 3102 SAVE TREF 3103 c$OMP THREADPRIVATE(TREF) 3040 3104 REAL*8 RT1(2) 3041 3105 SAVE RT1 3106 c$OMP THREADPRIVATE(RT1) 3042 3107 REAL*8 RAER(5,5) 3043 3108 SAVE RAER 3109 c$OMP THREADPRIVATE(RAER) 3044 3110 REAL*8 AT(8,3), BT(8,3) 3045 3111 SAVE AT, BT 3112 c$OMP THREADPRIVATE(AT, BT) 3046 3113 REAL*8 OCT(4) 3047 3114 SAVE OCT 3115 c$OMP THREADPRIVATE(OCT) 3048 3116 DATA TREF /250.0/ 3049 3117 DATA (RT1(IG1),IG1=1,2) / -0.577350269, +0.577350269 / … … 3333 3401 SUBROUTINE LWBV(KLIM,PDP,PDT0,PEMIS,PPMB,PTL,PTAVE,PABCU, 3334 3402 S PFLUC,PBINT,PBSUI,PCTS,PCNTRB) 3403 USE dimphy 3335 3404 IMPLICIT none 3336 #include "dimensions.h"3337 #include "dimphy.h"3338 #include "raddim.h"3405 cym#include "dimensions.h" 3406 cym#include "dimphy.h" 3407 cym#include "raddim.h" 3339 3408 #include "raddimlw.h" 3340 3409 #include "YOMCST.h" … … 3424 3493 R PBINT,PBSUIN,PCTS,PCNTRB, 3425 3494 S PFLUX) 3495 USE dimphy 3426 3496 IMPLICIT none 3427 #include "dimensions.h"3428 #include "dimphy.h"3429 #include "raddim.h"3497 cym#include "dimensions.h" 3498 cym#include "dimphy.h" 3499 cym#include "raddim.h" 3430 3500 #include "radepsi.h" 3431 3501 #include "radopt.h" … … 3829 3899 S , PB,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL 3830 3900 S , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP) 3901 USE dimphy 3831 3902 IMPLICIT none 3832 #include "dimensions.h"3833 #include "dimphy.h"3834 #include "raddim.h"3903 cym#include "dimensions.h" 3904 cym#include "dimphy.h" 3905 cym#include "raddim.h" 3835 3906 #include "raddimlw.h" 3836 3907 C … … 3925 3996 REAL*8 TINTP(11) 3926 3997 SAVE TINTP 3998 c$OMP THREADPRIVATE(TINTP) 3927 3999 REAL*8 GA(11,16,3), GB(11,16,3) 3928 4000 SAVE GA, GB 4001 c$OMP THREADPRIVATE(GA, GB) 3929 4002 REAL*8 XP(6,6) 3930 4003 SAVE XP 4004 c$OMP THREADPRIVATE(XP) 3931 4005 c 3932 4006 DATA TINTP / 187.5, 200., 212.5, 225., 237.5, 250., … … 5240 5314 R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP 5241 5315 S , PCNTRB,PCTS,PFLUC) 5316 USE dimphy 5242 5317 IMPLICIT none 5243 #include "dimensions.h"5244 #include "dimphy.h"5245 #include "raddim.h"5318 cym#include "dimensions.h" 5319 cym#include "dimphy.h" 5320 cym#include "raddim.h" 5246 5321 #include "raddimlw.h" 5247 5322 #include "YOMCST.h" … … 5353 5428 R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP 5354 5429 S , PCTS,PFLUC) 5430 USE dimphy 5355 5431 IMPLICIT none 5356 #include "dimensions.h"5357 #include "dimphy.h"5358 #include "raddim.h"5432 cym#include "dimensions.h" 5433 cym#include "dimphy.h" 5434 cym#include "raddim.h" 5359 5435 #include "raddimlw.h" 5360 5436 #include "radopt.h" … … 5685 5761 R , PGA,PGB 5686 5762 S , PCNTRB,PDISD,PDISU) 5763 USE dimphy 5687 5764 IMPLICIT none 5688 #include "dimensions.h"5689 #include "dimphy.h"5690 #include "raddim.h"5765 cym#include "dimensions.h" 5766 cym#include "dimphy.h" 5767 cym#include "raddim.h" 5691 5768 #include "raddimlw.h" 5692 5769 C … … 5937 6014 R , PABCU,PDBSL,PGA,PGB 5938 6015 S , PADJD,PADJU,PCNTRB,PDBDT) 6016 USE dimphy 5939 6017 IMPLICIT none 5940 #include "dimensions.h"5941 #include "dimphy.h"5942 #include "raddim.h"6018 cym#include "dimensions.h" 6019 cym#include "dimphy.h" 6020 cym#include "raddim.h" 5943 6021 #include "raddimlw.h" 5944 6022 C … … 6001 6079 REAL*8 WG1(2) 6002 6080 SAVE WG1 6081 c$OMP THREADPRIVATE(WG1) 6003 6082 DATA (WG1(jk),jk=1,2) /1.0, 1.0/ 6004 6083 C----------------------------------------------------------------------- … … 6144 6223 END 6145 6224 SUBROUTINE LWTT(PGA,PGB,PUU, PTT) 6225 USE dimphy 6146 6226 IMPLICIT none 6147 #include "dimensions.h"6148 #include "dimphy.h"6149 #include "raddim.h"6227 cym#include "dimensions.h" 6228 cym#include "dimphy.h" 6229 cym#include "raddim.h" 6150 6230 #include "raddimlw.h" 6151 6231 C … … 6319 6399 END 6320 6400 SUBROUTINE LWTTM(PGA,PGB,PUU1,PUU2, PTT) 6401 USE dimphy 6321 6402 IMPLICIT none 6322 #include "dimensions.h"6323 #include "dimphy.h"6324 #include "raddim.h"6403 cym#include "dimensions.h" 6404 cym#include "dimphy.h" 6405 cym#include "raddim.h" 6325 6406 #include "raddimlw.h" 6326 6407 C
Note: See TracChangeset
for help on using the changeset viewer.