Changeset 1293 for LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/etat0_netcdf.F

Timestamp:

Dec 22, 2009, 12:07:26 PM (14 years ago)

Author:

lguez

Message:

1) Replaced calls to "float" by calls to "real" and "dble" in
"phys_cosp". "call construct_cosp_gridbox(float(itap),..." was a bug
since the corresponding dummy argument has the type "double
precision". (And "float" is not in the Fortran standard.)

2) Modifications for the program "create_etat0_limit" only, "gcm" is
not touched:

2.1) Removed generic interface "startget" in module "startvar". Replaced
calls to "startget" by calls to "startget_phys2d", "startget_dyn" and
"startget_phys1d".

2.2) Simplified the interface of "startget_dyn" and made it more secure by
removing arguments for sizes of arrays and using assumed-shape array
arguments.

2.3) Corrected bug in call to "startget_dyn" for northward velocity. See
ticket #25 in Trac.

2.4) Collected procedures "inter_barxy", "inter_barx", "inter_bary",
"ord_coord" and "ord_coordm" in a module. "inter_barxy" is the only
public procedure in the module. Rewrote those five procedures: removed
arguments for sizes of arrays; used assumed-shape array arguments;
used array expressions; translated some spaghetti code in "inter_bary"
into structured code; corrected bug in "inter_bary", described by
ticket #26 in Trac.

2.5) Corrected a bug in "inter_bary": "y0" was initialized at 0
instead of -90. This bug made values at the south pole wrong. (This bug
has been acknowledeged by P. Le Van.)

2.6) Made the variable "champ" in procedure "limit_netcdf" an array of
rank 2. Thus it can be an argument in the call to the newly-secured
"inter_barxy".

2.7) The files "start.nc", "startphy.nc" and "limit.nc" are impacted
by this revision. There is a significant change in the variable "vcov"
of "start.nc". See
​http://web.lmd.jussieu.fr/~lglmd/Rev_1293/index.html. Note also the
changed value of "vcov" at the south pole. There is very little change
in other variables, in all three files.

File:

• LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/etat0_netcdf.F (modified) (9 diffs)

LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/etat0_netcdf.F

@@ -263 +263 @@
         varname = 'masque'
         masque(:,:) = 0.0
-        CALL startget(varname, iip1, jjp1, rlonv, rlatu, masque, 0.0,
-     ,  jjm ,rlonu,rlatv , interbar )
+        CALL startget_phys2d(varname, iip1, jjp1, rlonv, rlatu, masque,
+     $       0.0, jjm ,rlonu,rlatv , interbar )
         WRITE(*,*) 'MASQUE construit : Masque'
         WRITE(*,'(97I1)') nINT(masque(:,:))
@@ -324 +324 @@
       ! This line needs to be replaced by a call to restget to get the values in the restart file
       orog(:,:) = 0.0
-       CALL startget(varname, iip1, jjp1, rlonv, rlatu, orog, 0.0 ,
-     , jjm ,rlonu,rlatv , interbar, masque )
+       CALL startget_phys2d(varname, iip1, jjp1, rlonv, rlatu, orog,
+     $     0.0 , jjm ,rlonu,rlatv , interbar, masque )
       !
       WRITE(*,*) 'OUT OF GET VARIABLE : Relief'
@@ -333 +333 @@
       ! This line needs to be replaced by a call to restget to get the values in the restart file
       rugo(:,:) = 0.0
-       CALL startget(varname, iip1, jjp1, rlonv, rlatu, rugo, 0.0 ,
-     , jjm, rlonu,rlatv , interbar )
+       CALL startget_phys2d(varname, iip1, jjp1, rlonv, rlatu, rugo,
+     $     0.0 , jjm, rlonu,rlatv , interbar )
       !
       WRITE(*,*) 'OUT OF GET VARIABLE : Rugosite' 
@@ -346 +346 @@
       varname = 'psol'
       psol(:,:) = 0.0
-      CALL startget(varname, iip1, jjp1, rlonv, rlatu, psol, 0.0 ,
-     , jjm ,rlonu,rlatv , interbar )
+      CALL startget_phys2d(varname, iip1, jjp1, rlonv, rlatu, psol,
+     $     0.0 , jjm ,rlonu,rlatv , interbar )
       !
       !  Compute here the pressure on the intermediate levels. One would expect that this is available in the GCM 
@@ -375 +375 @@
       varname = 'surfgeo'
       phis(:,:) = 0.0
-      CALL startget(varname, iip1, jjp1, rlonv, rlatu, phis, 0.0 ,
-     , jjm ,rlonu,rlatv, interbar )
+      CALL startget_phys2d(varname, iip1, jjp1, rlonv, rlatu, phis,
+     $     0.0 , jjm ,rlonu,rlatv, interbar )
       !
       varname = 'u'
       uvent(:,:,:) = 0.0
-      CALL startget(varname, iip1, jjp1, rlonu, rlatu, llm, pls,
-     . workvar, uvent, 0.0, jjm ,rlonv, rlatv, interbar )
+      CALL startget_dyn(varname, rlonu, rlatu, pls, workvar, uvent, 0.,
+     $     rlonv, rlatv, interbar )
       !  
       varname = 'v'
       vvent(:,:,:) = 0.0
-      CALL startget(varname, iip1, jjm, rlonv, rlatv, llm, pls,
-     . workvar, vvent, 0.0, jjp1, rlonu, rlatu, interbar )
+      CALL startget_dyn(varname, rlonv, rlatv, pls(:, :jjm, :),
+     . workvar(:, :jjm, :), vvent, 0., rlonu, rlatu(:jjm), interbar )
       !
       varname = 't'
       t3d(:,:,:) = 0.0
-      CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
-     . workvar, t3d, 0.0 , jjm, rlonu, rlatv , interbar )
+      CALL startget_dyn(varname, rlonv, rlatu, pls, workvar, t3d, 0.,
+     $     rlonu, rlatv , interbar )
       !
       WRITE(*,*) 'T3D min,max:',minval(t3d(:,:,:)),
@@ -397 +397 @@
       varname = 'tpot'
       tpot(:,:,:) = 0.0
-      CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
-     . pk, tpot, 0.0 , jjm, rlonu, rlatv , interbar )
+      CALL startget_dyn(varname, rlonv, rlatu, pls, pk, tpot, 0., rlonu,
+     $     rlatv, interbar)
       !
       WRITE(*,*) 'T3D min,max:',minval(t3d(:,:,:)),
@@ -420 +420 @@
       WRITE(*,*) 'QSAT min,max:',minval(qsat(:,:,:)),
      .                           maxval(qsat(:,:,:))
-      CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
-     . qsat, qd, 0.0, jjm, rlonu, rlatv , interbar )
+      CALL startget_dyn(varname, rlonv, rlatu, pls, qsat, qd, 0., rlonu,
+     $     rlatv , interbar )
       q3d(:,:,:,1) = qd(:,:,:)
       !
@@ -431 +431 @@
       ! This line needs to be replaced by a call to restget to get the values in the restart file
       tsol(:) = 0.0
-      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, tsol, 0.0,
-     .    jjm, rlonu, rlatv , interbar )
+      CALL startget_phys1d(varname, iip1, jjp1, rlonv, rlatu, klon,
+     $     tsol, 0.0, jjm, rlonu, rlatv , interbar )
       !
       WRITE(*,*) 'TSOL construit :'
@@ -439 +439 @@
       varname = 'qsol'
       qsol(:) = 0.0
-      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, qsol, 0.0,
-     .   jjm, rlonu, rlatv , interbar )
+      CALL startget_phys1d(varname, iip1, jjp1, rlonv, rlatu, klon,
+     $     qsol, 0.0, jjm, rlonu, rlatv , interbar )
       !
       varname = 'snow'
       sn(:) = 0.0
-      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, sn, 0.0,
-     .    jjm, rlonu, rlatv , interbar )
+      CALL startget_phys1d(varname, iip1, jjp1, rlonv, rlatu, klon, sn,
+     $     0.0, jjm, rlonu, rlatv , interbar )
       !
       varname = 'rads'
       radsol(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,radsol,0.0,
-     .    jjm, rlonu, rlatv , interbar )
+      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,radsol,
+     $     0.0, jjm, rlonu, rlatv , interbar )
       !
       varname = 'rugmer'
       rugmer(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,rugmer,0.0,
-     .     jjm, rlonu, rlatv , interbar )
+      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,rugmer,
+     $     0.0, jjm, rlonu, rlatv , interbar )
       !
 !      varname = 'agesno'
 !      agesno(:) = 0.0
-!      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,agesno,0.0,
+!      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,agesno,0.0,
 !     .     jjm, rlonu, rlatv , interbar )
 
       varname = 'zmea'
       zmea(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0,
+      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0,
      .     jjm, rlonu, rlatv , interbar )
 
       varname = 'zstd'
       zstd(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0,
+      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0,
      .     jjm, rlonu, rlatv , interbar )
       varname = 'zsig'
       zsig(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0,
+      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0,
      .     jjm, rlonu, rlatv , interbar )
       varname = 'zgam'
       zgam(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0,
+      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0,
      .     jjm, rlonu, rlatv , interbar )
       varname = 'zthe'
       zthe(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0,
+      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0,
      .     jjm, rlonu, rlatv , interbar )
       varname = 'zpic'
       zpic(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0,
+      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0,
      .     jjm, rlonu, rlatv , interbar )
       varname = 'zval'
       zval(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zval,0.0,
+      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,zval,0.0,
      .     jjm, rlonu, rlatv , interbar )
 c