Changeset 2408 for LMDZ5/branches/testing/libf/phylmd/read_pstoke.F90

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:

• . (modified) (1 prop)
• libf/phylmd/read_pstoke.F90 (modified) (3 diffs)

LMDZ5/branches/testing/libf/phylmd/read_pstoke.F90

@@ -19 +19 @@
   USE netcdf
   USE dimphy
-  USE control_mod
   USE indice_sol_mod
+  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
 
   IMPLICIT NONE
 
   include "netcdf.inc"
-  include "dimensions.h"
-  include "paramet.h"
-  include "comconst.h"
-  include "comgeom.h"
-  include "temps.h"
-  include "ener.h"
-  include "logic.h"
-  include "description.h"
-  include "serre.h"
-  ! ccc#include "dimphy.h"
 
   INTEGER klono, klevo, imo, jmo
-  PARAMETER (imo=iim/2, jmo=(jjm+1)/2)
-  PARAMETER (klono=(jmo-1)*imo+2, klevo=llm)
-  REAL phisfi(klono)
-  REAL phisfi2(imo, jmo+1), airefi2(imo, jmo+1)
-
-  REAL mfu(klono, klevo), mfd(klono, klevo)
-  REAL en_u(klono, klevo), de_u(klono, klevo)
-  REAL en_d(klono, klevo), de_d(klono, klevo)
-  REAL coefh(klono, klevo)
-  REAL fm_therm(klono, klevo), en_therm(klono, klevo)
-
-  REAL mfu2(imo, jmo+1, klevo), mfd2(imo, jmo+1, klevo)
-  REAL en_u2(imo, jmo+1, klevo), de_u2(imo, jmo+1, klevo)
-  REAL en_d2(imo, jmo+1, klevo), de_d2(imo, jmo+1, klevo)
-  REAL coefh2(imo, jmo+1, klevo)
-  REAL fm_therm2(imo, jmo+1, klevo)
-  REAL en_therm2(imo, jmo+1, klevo)
-
-  REAL pl(klevo)
+!  PARAMETER (imo=iim/2, jmo=(jjm+1)/2)
+!  PARAMETER (klono=(jmo-1)*imo+2, klevo=llm)
+  REAL :: phisfi(((nbp_lat/2)-1)*(nbp_lon/2)+2) !phisfi(klono)
+  REAL,ALLOCATABLE :: phisfi2(:,:) !phisfi2(imo,jmo+1)
+  REAL,ALLOCATABLE :: airefi2(:,:) !airefi2(imo, jmo+1)
+
+  REAL :: mfu(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) ! mfu(klono, klevo)
+  REAL :: mfd(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) ! mfd(klono, klevo)
+  REAL :: en_u(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !en_u(klono, klevo)
+  REAL :: de_u(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !de_u(klono, klevo)
+  REAL :: en_d(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !en_d(klono, klevo)
+  REAL :: de_d(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !de_d(klono, klevo)
+  REAL :: coefh(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !coefh(klono, klevo)
+  REAL :: fm_therm(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !fm_therm(klono, klevo)
+  REAL :: en_therm(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !en_therm(klono, klevo)
+
+  REAL,ALLOCATABLE :: mfu2(:,:,:) !mfu2(imo, jmo+1, klevo)
+  REAL,ALLOCATABLE :: mfd2(:,:,:) !mfd2(imo, jmo+1, klevo)
+  REAL,ALLOCATABLE :: en_u2(:,:,:) !en_u2(imo, jmo+1, klevo)
+  REAL,ALLOCATABLE :: de_u2(:,:,:) !de_u2(imo, jmo+1, klevo)
+  REAL,ALLOCATABLE :: en_d2(:,:,:) !en_d2(imo, jmo+1, klevo)
+  REAL,ALLOCATABLE :: de_d2(:,:,:) !de_d2(imo, jmo+1, klevo)
+  REAL,ALLOCATABLE :: coefh2(:,:,:) !coefh2(imo, jmo+1, klevo)
+  REAL,ALLOCATABLE :: fm_therm2(:,:,:) !fm_therm2(imo, jmo+1, klevo)
+  REAL,ALLOCATABLE :: en_therm2(:,:,:) !en_therm2(imo, jmo+1, klevo)
+
+  REAL,ALLOCATABLE :: pl(:) !pl(klevo)
   INTEGER irec
   INTEGER xid, yid, zid, tid
@@ -61 +59 @@
   INTEGER ncrec, ncklono, ncklevo, ncim, ncjm
 
-  REAL airefi(klono)
+  REAL :: airefi(((nbp_lat/2)-1)*(nbp_lon/2)+2) !airefi(klono)
   CHARACTER *20 namedim
 
@@ -69 +67 @@
 
 
-  REAL frac_impa(klono, klevo), frac_nucl(klono, klevo)
-  REAL frac_impa2(imo, jmo+1, klevo), frac_nucl2(imo, jmo+1, klevo)
-  REAL pyu1(klono), pyv1(klono)
-  REAL pyu12(imo, jmo+1), pyv12(imo, jmo+1)
-  REAL ftsol(klono, nbsrf)
-  REAL psrf(klono, nbsrf)
-  REAL ftsol1(klono), ftsol2(klono), ftsol3(klono), ftsol4(klono)
-  REAL psrf1(klono), psrf2(klono), psrf3(klono), psrf4(klono)
-  REAL ftsol12(imo, jmo+1), ftsol22(imo, jmo+1), ftsol32(imo, jmo+1), &
-    ftsol42(imo, jmo+1)
-  REAL psrf12(imo, jmo+1), psrf22(imo, jmo+1), psrf32(imo, jmo+1), &
-    psrf42(imo, jmo+1)
-  REAL t(klono, klevo)
-  REAL t2(imo, jmo+1, klevo)
-  INTEGER ncidp
-  SAVE ncidp
-  INTEGER varidt
-  INTEGER varidmfu, varidmfd, varidps, varidenu, variddeu
-  INTEGER varidend, varidded, varidch, varidfi, varidfn
-  INTEGER varidfmth, varidenth
-  INTEGER varidyu1, varidyv1, varidpl, varidai, varididvt
-  INTEGER varidfts1, varidfts2, varidfts3, varidfts4
-  INTEGER varidpsr1, varidpsr2, varidpsr3, varidpsr4
-  SAVE varidmfu, varidmfd, varidps, varidenu, variddeu
-  SAVE varidend, varidded, varidch, varidfi, varidfn
-  SAVE varidfmth, varidenth
-  SAVE varidyu1, varidyv1, varidpl, varidai, varididvt
-  SAVE varidfts1, varidfts2, varidfts3, varidfts4
-  SAVE varidpsr1, varidpsr2, varidpsr3, varidpsr4
-  SAVE varidt
+  REAL :: frac_impa(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !frac_impa(klono, klevo)
+  REAL :: frac_nucl(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !frac_nucl(klono, klevo)
+  REAL,ALLOCATABLE :: frac_impa2(:,:,:) !frac_impa2(imo, jmo+1, klevo)
+  REAL,ALLOCATABLE :: frac_nucl2(:,:,:) !frac_nucl2(imo, jmo+1, klevo)
+  REAL :: pyu1(((nbp_lat/2)-1)*(nbp_lon/2)+2) !pyu1(klono)
+  REAL :: pyv1(((nbp_lat/2)-1)*(nbp_lon/2)+2) !pyv1(klono)
+  REAL,ALLOCATABLE :: pyu12(:,:), pyv12(:,:) !pyu12(imo, jmo+1), pyv12(imo, jmo+1)
+  REAL :: ftsol(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !ftsol(klono, nbsrf)
+  REAL :: psrf(((nbp_lat/2)-1)*(nbp_lon/2)+2,nbp_lev) !psrf(klono, nbsrf)
+  REAL,ALLOCATABLE :: ftsol1(:),ftsol2(:) !ftsol1(klono), ftsol2(klono)
+  REAL,ALLOCATABLE :: ftsol3(:),ftsol4(:) !ftsol3(klono), ftsol4(klono)
+  REAL,ALLOCATABLE :: psrf1(:), psrf2(:) !psrf1(klono), psrf2(klono)
+  REAL,ALLOCATABLE :: psrf3(:), psrf4(:) !psrf3(klono), psrf4(klono)
+  REAL,ALLOCATABLE :: ftsol12(:,:) !ftsol12(imo, jmo+1)
+  REAL,ALLOCATABLE :: ftsol22(:,:) !ftsol22(imo, jmo+1)
+  REAL,ALLOCATABLE :: ftsol32(:,:) !ftsol32(imo, jmo+1)
+  REAL,ALLOCATABLE :: ftsol42(:,:) !ftsol42(imo, jmo+1)
+  REAL,ALLOCATABLE :: psrf12(:,:) !psrf12(imo, jmo+1)
+  REAL,ALLOCATABLE :: psrf22(:,:) !psrf22(imo, jmo+1)
+  REAL,ALLOCATABLE :: psrf32(:,:) !psrf32(imo, jmo+1)
+  REAL,ALLOCATABLE :: psrf42(:,:) !psrf42(imo, jmo+1)
+  REAL :: t(((nbp_lon/2)-1)*(nbp_lat/2)+2,nbp_lev) !t(klono, klevo)
+  REAL,ALLOCATABLE :: t2(:,:,:) !t2(imo, jmo+1, klevo)
+  INTEGER,SAVE :: ncidp
+  INTEGER,SAVE :: varidt
+  INTEGER,SAVE :: varidmfu, varidmfd, varidps, varidenu, variddeu
+  INTEGER,SAVE :: varidend, varidded, varidch, varidfi, varidfn
+  INTEGER,SAVE :: varidfmth, varidenth
+  INTEGER,SAVE :: varidyu1, varidyv1, varidpl, varidai, varididvt
+  INTEGER,SAVE :: varidfts1, varidfts2, varidfts3, varidfts4
+  INTEGER,SAVE :: varidpsr1, varidpsr2, varidpsr3, varidpsr4
 
   INTEGER l, i
   INTEGER start(4), count(4), status
   REAL rcode
-  LOGICAL first
-  SAVE first
-  DATA first/.TRUE./
-
-
+  LOGICAL,SAVE :: first=.TRUE.
+
+  ! Allocate arrays
+  imo=nbp_lon/2
+  jmo=nbp_lat/2
+  klono=(jmo-1)*imo+2
+  klevo=nbp_lev
+  
+  ALLOCATE(phisfi2(imo,jmo+1))
+  ALLOCATE(airefi2(imo, jmo+1))
+  ALLOCATE(mfu2(imo, jmo+1, klevo))
+  ALLOCATE(mfd2(imo, jmo+1, klevo))
+  ALLOCATE(en_u2(imo, jmo+1, klevo))
+  ALLOCATE(de_u2(imo, jmo+1, klevo))
+  ALLOCATE(en_d2(imo, jmo+1, klevo))
+  ALLOCATE(de_d2(imo, jmo+1, klevo))
+  ALLOCATE(coefh2(imo, jmo+1, klevo))
+  ALLOCATE(fm_therm2(imo, jmo+1, klevo))
+  ALLOCATE(en_therm2(imo, jmo+1, klevo))
+  ALLOCATE(pl(klevo))
+  ALLOCATE(frac_impa2(imo, jmo+1, klevo))
+  ALLOCATE(frac_nucl2(imo, jmo+1, klevo))
+  ALLOCATE(pyu12(imo, jmo+1), pyv12(imo, jmo+1))
+  ALLOCATE(ftsol1(klono), ftsol2(klono))
+  ALLOCATE(ftsol3(klono), ftsol4(klono))
+  ALLOCATE(psrf1(klono), psrf2(klono))
+  ALLOCATE(psrf3(klono), psrf4(klono))
+  ALLOCATE(ftsol12(imo, jmo+1))
+  ALLOCATE(ftsol22(imo, jmo+1))
+  ALLOCATE(ftsol32(imo, jmo+1))
+  ALLOCATE(ftsol42(imo, jmo+1))
+  ALLOCATE(psrf12(imo, jmo+1))
+  ALLOCATE(psrf22(imo, jmo+1))
+  ALLOCATE(psrf32(imo, jmo+1))
+  ALLOCATE(psrf42(imo, jmo+1))
+  ALLOCATE(t2(imo, jmo+1, klevo))
 
   ! ---------------------------------------------