Ignore:
Timestamp:
Dec 14, 2015, 11:43:09 AM (9 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r2298:2396 into testing branch

Location:
LMDZ5/branches/testing
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/phylmd/read_pstoke0.F90

    r1999 r2408  
    1818  USE netcdf
    1919  USE dimphy
    20   USE control_mod
    2120  USE indice_sol_mod
     21  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
    2222
    2323  IMPLICIT NONE
    2424
    2525  include "netcdf.inc"
    26   include "dimensions.h"
    27   include "paramet.h"
    28   include "comconst.h"
    29   include "comgeom.h"
    30   include "temps.h"
    31   include "ener.h"
    32   include "logic.h"
    33   include "description.h"
    34   include "serre.h"
    35   ! ccc#include "dimphy.h"
    3626
    3727  INTEGER kon, kev, zkon, zkev
    38   PARAMETER (kon=iim*(jjm-1)+2, kev=llm)
    39   REAL phisfi(kon)
    40   REAL phisfi2(iim, jjm+1), airefi2(iim, jjm+1)
    41 
    42   REAL mfu(kon, kev), mfd(kon, kev)
    43   REAL en_u(kon, kev), de_u(kon, kev)
    44   REAL en_d(kon, kev), de_d(kon, kev)
    45   REAL coefh(kon, kev)
     28!  PARAMETER (kon=iim*(jjm-1)+2, kev=llm)
     29  REAL :: phisfi(nbp_lon*(nbp_lat-2)+2) !phisfi(kon)
     30  REAL,ALLOCATABLE :: phisfi2(:,:) !phisfi2(nbp_lon, nbp_lat)
     31  REAL,ALLOCATABLE :: airefi2(:,:) !airefi2(nbp_lon, nbp_lat)
     32
     33  REAL :: mfu(nbp_lon*(nbp_lat-2)+2,nbp_lev) !mfu(kon, kev)
     34  REAL :: mfd(nbp_lon*(nbp_lat-2)+2,nbp_lev) !mfd(kon, kev)
     35  REAL :: en_u(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_u(kon, kev)
     36  REAL :: de_u(nbp_lon*(nbp_lat-2)+2,nbp_lev) !de_u(kon, kev)
     37  REAL :: en_d(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_d(kon, kev)
     38  REAL :: de_d(nbp_lon*(nbp_lat-2)+2,nbp_lev) !de_d(kon, kev)
     39  REAL :: coefh(nbp_lon*(nbp_lat-2)+2,nbp_lev) !coefh(kon, kev)
    4640
    4741  ! abd 25 11 02
    4842  ! Thermiques
    49   REAL fm_therm(kon, kev), en_therm(kon, kev)
    50   REAL t(kon, kev)
    51 
    52   REAL mfu2(iim, jjm+1, kev), mfd2(iim, jjm+1, kev)
    53   REAL en_u2(iim, jjm+1, kev), de_u2(iim, jjm+1, kev)
    54   REAL en_d2(iim, jjm+1, kev), de_d2(iim, jjm+1, kev)
    55   REAL coefh2(iim, jjm+1, kev)
    56   REAL t2(iim, jjm+1, kev)
     43  REAL :: fm_therm(nbp_lon*(nbp_lat-2)+2,nbp_lev) !fm_therm(kon, kev)
     44  REAL :: en_therm(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_therm(kon, kev)
     45  REAL :: t(nbp_lon*(nbp_lat-2)+2,nbp_lev) !t(kon, kev)
     46
     47  REAL,ALLOCATABLE :: mfu2(:,:,:) !mfu2(nbp_lon, nbp_lat, kev)
     48  REAL,ALLOCATABLE :: mfd2(:,:,:) !mfd2(nbp_lon, nbp_lat, kev)
     49  REAL,ALLOCATABLE :: en_u2(:,:,:) !en_u2(nbp_lon, nbp_lat, kev)
     50  REAL,ALLOCATABLE :: de_u2(:,:,:) !de_u2(nbp_lon, nbp_lat, kev)
     51  REAL,ALLOCATABLE :: en_d2(:,:,:) !en_d2(nbp_lon, nbp_lat, kev)
     52  REAL,ALLOCATABLE :: de_d2(:,:,:) !de_d2(nbp_lon, nbp_lat, kev)
     53  REAL,ALLOCATABLE :: coefh2(:,:,:) !coefh2(nbp_lon, nbp_lat, kev)
     54  REAL,ALLOCATABLE :: t2(:,:,:) !t2(nbp_lon, nbp_lat, kev)
    5755  ! Thermiques
    58   REAL fm_therm2(iim, jjm+1, kev)
    59   REAL en_therm2(iim, jjm+1, kev)
    60 
    61   REAL pl(kev)
     56  REAL,ALLOCATABLE :: fm_therm2(:,:,:) !fm_therm2(nbp_lon, nbp_lat, kev)
     57  REAL,ALLOCATABLE :: en_therm2(:,:,:) !en_therm2(nbp_lon, nbp_lat, kev)
     58
     59  REAL,ALLOCATABLE :: pl(:) !pl(kev)
    6260  INTEGER irec
    6361  INTEGER xid, yid, zid, tid
     
    6563  INTEGER ncrec, nckon, nckev, ncim, ncjm
    6664
    67   REAL airefi(kon)
     65  REAL :: airefi(nbp_lon*(nbp_lat-2)+2) !airefi(kon)
    6866  CHARACTER *20 namedim
    6967
     
    7270  ! dim de phis??
    7371
    74   REAL frac_impa(kon, kev), frac_nucl(kon, kev)
    75   REAL frac_impa2(iim, jjm+1, kev), frac_nucl2(iim, jjm+1, kev)
    76   REAL pyu1(kon), pyv1(kon)
    77   REAL pyu12(iim, jjm+1), pyv12(iim, jjm+1)
    78   REAL ftsol(kon, nbsrf)
    79   REAL psrf(kon, nbsrf)
    80   REAL ftsol1(kon), ftsol2(kon), ftsol3(kon), ftsol4(kon)
    81   REAL psrf1(kon), psrf2(kon), psrf3(kon), psrf4(kon)
    82   REAL ftsol12(iim, jjm+1), ftsol22(iim, jjm+1), ftsol32(iim, jjm+1), &
    83     ftsol42(iim, jjm+1)
    84   REAL psrf12(iim, jjm+1), psrf22(iim, jjm+1), psrf32(iim, jjm+1), &
    85     psrf42(iim, jjm+1)
    86 
    87   INTEGER ncidp
    88   SAVE ncidp
    89   INTEGER varidmfu, varidmfd, varidps, varidenu, variddeu
    90   INTEGER varidt
    91   INTEGER varidend, varidded, varidch, varidfi, varidfn
     72  REAL :: frac_impa(nbp_lon*(nbp_lat-2)+2,nbp_lev) !frac_impa(kon, kev)
     73  REAL :: frac_nucl(nbp_lon*(nbp_lat-2)+2,nbp_lev) !frac_nucl(kon, kev)
     74  REAL,ALLOCATABLE :: frac_impa2(:,:,:) !frac_impa2(nbp_lon, nbp_lat, kev)
     75  REAL,ALLOCATABLE :: frac_nucl2(:,:,:) !frac_nucl2(nbp_lon, nbp_lat, kev)
     76  REAL :: pyu1(nbp_lon*(nbp_lat-2)+2) !pyu1(kon)
     77  REAL :: pyv1(nbp_lon*(nbp_lat-2)+2) !pyv1(kon)
     78  REAL,ALLOCATABLE :: pyu12(:,:), pyv12(:,:) !pyu12(nbp_lon, nbp_lat), pyv12(nbp_lon, nbp_lat)
     79  REAL :: ftsol(nbp_lon*(nbp_lat-2)+2,nbp_lev) !ftsol(kon, nbsrf)
     80  REAL :: psrf(nbp_lon*(nbp_lat-2)+2,nbp_lev) !psrf(kon, nbsrf)
     81  REAL,ALLOCATABLE :: ftsol1(:),ftsol2(:) !ftsol1(kon), ftsol2(kon)
     82  REAL,ALLOCATABLE :: ftsol3(:),ftsol4(:) !ftsol3(kon), ftsol4(kon)
     83  REAL,ALLOCATABLE :: psrf1(:), psrf2(:) !psrf1(kon), psrf2(kon)
     84  REAL,ALLOCATABLE :: psrf3(:), psrf4(:) !psrf3(kon), psrf4(kon)
     85  REAL,ALLOCATABLE :: ftsol12(:,:) !ftsol12(nbp_lon, nbp_lat)
     86  REAL,ALLOCATABLE :: ftsol22(:,:) !ftsol22(nbp_lon, nbp_lat)
     87  REAL,ALLOCATABLE :: ftsol32(:,:) !ftsol32(nbp_lon, nbp_lat)
     88  REAL,ALLOCATABLE :: ftsol42(:,:) !ftsol42(nbp_lon, nbp_lat)
     89  REAL,ALLOCATABLE :: psrf12(:,:) !psrf12(nbp_lon, nbp_lat)
     90  REAL,ALLOCATABLE :: psrf22(:,:) !psrf22(nbp_lon, nbp_lat)
     91  REAL,ALLOCATABLE :: psrf32(:,:) !psrf32(nbp_lon, nbp_lat)
     92  REAL,ALLOCATABLE :: psrf42(:,:) !psrf42(nbp_lon, nbp_lat)
     93
     94  INTEGER,SAVE :: ncidp
     95  INTEGER,SAVE :: varidmfu, varidmfd, varidps, varidenu, variddeu
     96  INTEGER,SAVE :: varidt
     97  INTEGER,SAVE :: varidend, varidded, varidch, varidfi, varidfn
    9298  ! therm
    93   INTEGER varidfmth, varidenth
    94   INTEGER varidyu1, varidyv1, varidpl, varidai, varididvt
    95   INTEGER varidfts1, varidfts2, varidfts3, varidfts4
    96   INTEGER varidpsr1, varidpsr2, varidpsr3, varidpsr4
    97   SAVE varidmfu, varidmfd, varidps, varidenu, variddeu
    98   SAVE varidt
    99   SAVE varidend, varidded, varidch, varidfi, varidfn
    100   ! therm
    101   SAVE varidfmth, varidenth
    102   SAVE varidyu1, varidyv1, varidpl, varidai, varididvt
    103   SAVE varidfts1, varidfts2, varidfts3, varidfts4
    104   SAVE varidpsr1, varidpsr2, varidpsr3, varidpsr4
     99  INTEGER,SAVE :: varidfmth, varidenth
     100  INTEGER,SAVE :: varidyu1, varidyv1, varidpl, varidai, varididvt
     101  INTEGER,SAVE :: varidfts1, varidfts2, varidfts3, varidfts4
     102  INTEGER,SAVE :: varidpsr1, varidpsr2, varidpsr3, varidpsr4
    105103
    106104  INTEGER l, i
    107105  INTEGER start(4), count(4), status
    108106  REAL rcode
    109   LOGICAL first
    110   SAVE first
    111   DATA first/.TRUE./
    112 
    113 
     107  LOGICAL,SAVE :: first=.TRUE.
     108
     109  ! Allocate arrays
     110  kon=nbp_lon*(nbp_lat-2)+2
     111  kev=nbp_lev
     112
     113  ALLOCATE(phisfi2(nbp_lon, nbp_lat))
     114  ALLOCATE(airefi2(nbp_lon, nbp_lat))
     115  ALLOCATE(mfu2(nbp_lon, nbp_lat, kev))
     116  ALLOCATE(mfd2(nbp_lon, nbp_lat, kev))
     117  ALLOCATE(en_u2(nbp_lon, nbp_lat, kev))
     118  ALLOCATE(de_u2(nbp_lon, nbp_lat, kev))
     119  ALLOCATE(en_d2(nbp_lon, nbp_lat, kev))
     120  ALLOCATE(de_d2(nbp_lon, nbp_lat, kev))
     121  ALLOCATE(coefh2(nbp_lon, nbp_lat, kev))
     122  ALLOCATE(t2(nbp_lon, nbp_lat, kev))
     123  ALLOCATE(fm_therm2(nbp_lon, nbp_lat, kev))
     124  ALLOCATE(en_therm2(nbp_lon, nbp_lat, kev))
     125  ALLOCATE(pl(kev))
     126  ALLOCATE(frac_impa2(nbp_lon, nbp_lat, kev))
     127  ALLOCATE(frac_nucl2(nbp_lon, nbp_lat, kev))
     128  ALLOCATE(pyu12(nbp_lon, nbp_lat), pyv12(nbp_lon, nbp_lat))
     129  ALLOCATE(ftsol1(kon), ftsol2(kon))
     130  ALLOCATE(ftsol3(kon), ftsol4(kon))
     131  ALLOCATE(psrf1(kon), psrf2(kon))
     132  ALLOCATE(psrf3(kon), psrf4(kon))
     133  ALLOCATE(ftsol12(nbp_lon, nbp_lat))
     134  ALLOCATE(ftsol22(nbp_lon, nbp_lat))
     135  ALLOCATE(ftsol32(nbp_lon, nbp_lat))
     136  ALLOCATE(ftsol42(nbp_lon, nbp_lat))
     137  ALLOCATE(psrf12(nbp_lon, nbp_lat))
     138  ALLOCATE(psrf22(nbp_lon, nbp_lat))
     139  ALLOCATE(psrf32(nbp_lon, nbp_lat))
     140  ALLOCATE(psrf42(nbp_lon, nbp_lat))
    114141
    115142  ! ---------------------------------------------
     
    248275    status = nf_get_vara_real(ncidp, varidps, start, count, phisfi2)
    249276#endif
    250     CALL gr_ecrit_fi(1, kon, iim, jjm+1, phisfi2, phisfi)
     277    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, phisfi2, phisfi)
    251278
    252279    ! **** Aires des mails aux sol ************************************
     
    257284    status = nf_get_vara_real(ncidp, varidai, start, count, airefi2)
    258285#endif
    259     CALL gr_ecrit_fi(1, kon, iim, jjm+1, airefi2, airefi)
     286    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, airefi2, airefi)
    260287  ELSE
    261288
     
    288315    status = nf_get_vara_real(ncidp, varidt, start, count, t2)
    289316#endif
    290     CALL gr_ecrit_fi(kev, kon, iim, jjm+1, t2, t)
     317    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, t2, t)
    291318
    292319    ! **** Flux pour la convection (Tiedtk)
     
    298325    status = nf_get_vara_real(ncidp, varidmfu, start, count, mfu2)
    299326#endif
    300     CALL gr_ecrit_fi(kev, kon, iim, jjm+1, mfu2, mfu)
     327    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfu2, mfu)
    301328
    302329    ! mfd
     
    306333    status = nf_get_vara_real(ncidp, varidmfd, start, count, mfd2)
    307334#endif
    308     CALL gr_ecrit_fi(kev, kon, iim, jjm+1, mfd2, mfd)
     335    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfd2, mfd)
    309336
    310337    ! en_u
     
    314341    status = nf_get_vara_real(ncidp, varidenu, start, count, en_u2)
    315342#endif
    316     CALL gr_ecrit_fi(kev, kon, iim, jjm+1, en_u2, en_u)
     343    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_u2, en_u)
    317344
    318345    ! de_u
     
    322349    status = nf_get_vara_real(ncidp, variddeu, start, count, de_u2)
    323350#endif
    324     CALL gr_ecrit_fi(kev, kon, iim, jjm+1, de_u2, de_u)
     351    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_u2, de_u)
    325352
    326353    ! en_d
     
    330357    status = nf_get_vara_real(ncidp, varidend, start, count, en_d2)
    331358#endif
    332     CALL gr_ecrit_fi(kev, kon, iim, jjm+1, en_d2, en_d)
     359    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_d2, en_d)
    333360
    334361    ! de_d
     
    338365    status = nf_get_vara_real(ncidp, varidded, start, count, de_d2)
    339366#endif
    340     CALL gr_ecrit_fi(kev, kon, iim, jjm+1, de_d2, de_d)
     367    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_d2, de_d)
    341368
    342369    ! **** Coefficient de mellange turbulent
     
    349376    status = nf_get_vara_real(ncidp, varidch, start, count, coefh2)
    350377#endif
    351     CALL gr_ecrit_fi(kev, kon, iim, jjm+1, coefh2, coefh)
     378    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, coefh2, coefh)
    352379    ! call dump2d(iip1,jjp1,coefh2(1,2),'COEFH2READ   ')
    353380    ! call dump2d(iim ,jjm ,coefh (2,2),'COEFH2READ   ')
     
    362389    status = nf_get_vara_real(ncidp, varidfmth, start, count, fm_therm2)
    363390#endif
    364     CALL gr_ecrit_fi(kev, kon, iim, jjm+1, fm_therm2, fm_therm)
     391    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, fm_therm2, fm_therm)
    365392    PRINT *, 'LECTURE de en_therm a irec =', irec
    366393#ifdef NC_DOUBLE
     
    369396    status = nf_get_vara_real(ncidp, varidenth, start, count, en_therm2)
    370397#endif
    371     CALL gr_ecrit_fi(kev, kon, iim, jjm+1, en_therm2, en_therm)
     398    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_therm2, en_therm)
    372399
    373400    ! **** Coefficients de lessivage
     
    379406    status = nf_get_vara_real(ncidp, varidfi, start, count, frac_impa2)
    380407#endif
    381     CALL gr_ecrit_fi(kev, kon, iim, jjm+1, frac_impa2, frac_impa)
     408    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_impa2, frac_impa)
    382409
    383410    ! frac_nucl
     
    388415    status = nf_get_vara_real(ncidp, varidfn, start, count, frac_nucl2)
    389416#endif
    390     CALL gr_ecrit_fi(kev, kon, iim, jjm+1, frac_nucl2, frac_nucl)
     417    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_nucl2, frac_nucl)
    391418
    392419    ! **** Vents aux sol ********************************************
     
    404431    status = nf_get_vara_real(ncidp, varidyu1, start, count, pyu12)
    405432#endif
    406     CALL gr_ecrit_fi(1, kon, iim, jjm+1, pyu12, pyu1)
     433    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyu12, pyu1)
    407434
    408435    ! pyv1
     
    413440    status = nf_get_vara_real(ncidp, varidyv1, start, count, pyv12)
    414441#endif
    415     CALL gr_ecrit_fi(1, kon, iim, jjm+1, pyv12, pyv1)
     442    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyv12, pyv1)
    416443
    417444    ! **** Temerature au sol ********************************************
     
    423450    status = nf_get_vara_real(ncidp, varidfts1, start, count, ftsol12)
    424451#endif
    425     CALL gr_ecrit_fi(1, kon, iim, jjm+1, ftsol12, ftsol1)
     452    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol12, ftsol1)
    426453
    427454    ! ftsol2
     
    432459    status = nf_get_vara_real(ncidp, varidfts2, start, count, ftsol22)
    433460#endif
    434     CALL gr_ecrit_fi(1, kon, iim, jjm+1, ftsol22, ftsol2)
     461    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol22, ftsol2)
    435462
    436463    ! ftsol3
     
    441468    status = nf_get_vara_real(ncidp, varidfts3, start, count, ftsol32)
    442469#endif
    443     CALL gr_ecrit_fi(1, kon, iim, jjm+1, ftsol32, ftsol3)
     470    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol32, ftsol3)
    444471
    445472    ! ftsol4
     
    449476    status = nf_get_vara_real(ncidp, varidfts4, start, count, ftsol42)
    450477#endif
    451     CALL gr_ecrit_fi(1, kon, iim, jjm+1, ftsol42, ftsol4)
     478    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol42, ftsol4)
    452479
    453480    ! **** Nature sol ********************************************
     
    459486#endif
    460487    ! call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC')
    461     CALL gr_ecrit_fi(1, kon, iim, jjm+1, psrf12, psrf1)
     488    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf12, psrf1)
    462489
    463490    ! psrf2
     
    468495#endif
    469496    ! call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC')
    470     CALL gr_ecrit_fi(1, kon, iim, jjm+1, psrf22, psrf2)
     497    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf22, psrf2)
    471498
    472499    ! psrf3
     
    476503    status = nf_get_vara_real(ncidp, varidpsr3, start, count, psrf32)
    477504#endif
    478     CALL gr_ecrit_fi(1, kon, iim, jjm+1, psrf32, psrf3)
     505    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf32, psrf3)
    479506
    480507    ! psrf4
     
    484511    status = nf_get_vara_real(ncidp, varidpsr4, start, count, psrf42)
    485512#endif
    486     CALL gr_ecrit_fi(1, kon, iim, jjm+1, psrf42, psrf4)
     513    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf42, psrf4)
    487514
    488515    DO i = 1, kon
Note: See TracChangeset for help on using the changeset viewer.