Ignore:
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:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/startvar.F

    r1279 r1293  
    99    !      There are three ways to access data from the database of atmospheric data which
    1010    !       can be used to initialize the model. This depends on the type of field which needs
    11     !       to be extracted. In any case the call should come after a restget and should be of the type :
    12     !                CALL startget(...)
    13     !
     11    !       to be extracted.
    1412    !       We will details the possible arguments to startget here :
    1513    !
    1614    !        - A 2D variable on the dynamical grid :
    17     !           CALL startget(varname, iml, jml, lon_in, lat_in, champ, val_ex, jml2, lon_in2, lat_in2, interbar )             
     15    !           CALL startget_phys2d(varname, iml, jml, lon_in, lat_in, champ, val_ex, jml2, lon_in2, lat_in2, interbar )             
    1816    !
    1917    !        - A 1D variable on the physical grid :
    20     !            CALL startget(varname, iml, jml, lon_in, lat_in, nbindex, champ, val_exp, jml2, lon_in2, lat_in2, interbar )
     18    !            CALL startget_phys1d(varname, iml, jml, lon_in, lat_in, nbindex, champ, val_exp, jml2, lon_in2, lat_in2, interbar )
    2119    !
    2220    !
    2321    !         - A 3D variable on the dynamical grid :
    24     !            CALL startget(varname, iml, jml, lon_in, lat_in, lml, pls, workvar, champ, val_exp, jml2, lon_in2, lat_in2, interbar )
     22    !            CALL startget_dyn(varname, iml, jml, lon_in, lat_in, lml, pls, workvar, champ, val_exp, jml2, lon_in2, lat_in2, interbar )
    2523    !
    2624    !
    … …  
    4644    !
    4745      PRIVATE
    48       PUBLIC startget
    49     !
    50     !
    51       INTERFACE startget
    52         MODULE PROCEDURE startget_phys2d, startget_phys1d, startget_dyn
    53       END INTERFACE
     46      public startget_phys2d, startget_phys1d, startget_dyn
    5447    !
    5548      INTEGER, SAVE :: fid_phys, fid_dyn
    … …  
    553546      SUBROUTINE start_init_phys( iml, jml, lon_in, lat_in, jml2,
    554547     .                 lon_in2, lat_in2 , interbar )
     548
     549      use inter_barxy_m, only: inter_barxy
    555550    !
    556551      INTEGER, INTENT(in) :: iml, jml ,jml2
    … …  
    648643        WRITE(6,*) '-------------------------------------------------',
    649644     ,'--------------'
    650         CALL inter_barxy ( iml_phys,jml_phys -1,lon_rad,lat_rad ,
    651      ,   var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var   )
     645        CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana,
     646     $       lon_in2(:iml-1), lat_in2(:jml-1), tmp_var)
    652647      ELSE
    653648        CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
    … …  
    674669        WRITE(6,*) '-------------------------------------------------',
    675670     ,'--------------'
    676         CALL inter_barxy ( iml_phys,jml_phys -1,lon_rad,lat_rad ,
    677      ,   var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var  )
     671        CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana,
     672     $       lon_in2(:iml-1), lat_in2(:jml-1), tmp_var)
    678673      ELSE
    679674        CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
    … …  
    691686    !
    692687    !
    693       SUBROUTINE startget_dyn(varname, iml, jml, lon_in, lat_in,
    694      . lml, pls, workvar, champ, val_exp,jml2, lon_in2, lat_in2 ,
     688      SUBROUTINE startget_dyn(varname, lon_in, lat_in,
     689     . pls, workvar, champ, val_exp, lon_in2, lat_in2 ,
    695690     ,  interbar )
     691
     692      use assert_eq_m, only: assert_eq
    696693    !
    697694    !   ARGUMENTS
    698695    !
    699       CHARACTER*(*), INTENT(in) :: varname
    700       INTEGER, INTENT(in) :: iml, jml, lml, jml2
    701       REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
    702       REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
    703       REAL, INTENT(in) :: pls(iml, jml, lml)
    704       REAL, INTENT(in) :: workvar(iml, jml, lml)
    705       REAL, INTENT(inout) :: champ(iml, jml, lml)
     696      CHARACTER(len=*), INTENT(in) :: varname
     697      REAL, INTENT(in) :: lon_in(:) ! dim(iml)
     698      REAL, INTENT(in) :: lat_in(:) ! dim(jml)
     699      REAL, INTENT(in) :: lon_in2(:) ! dim(iml)
     700      REAL, INTENT(in) :: lat_in2(:) ! dim(jml2)
     701      REAL, INTENT(in) :: pls(:, :, :) ! dim(iml, jml, lml)
     702      REAL, INTENT(in) :: workvar(:, :, :) ! dim(iml, jml, lml)
     703      REAL, INTENT(inout) :: champ(:, :, :) ! dim(iml, jml, lml)
    706704      REAL, INTENT(in) :: val_exp
    707705      LOGICAL interbar
    … …  
    709707    !    LOCAL
    710708    !
    711       INTEGER :: il, ij, ii
     709      INTEGER :: il, ij, ii, iml, jml, lml, jml2
    712710      REAL :: xppn, xpps
    713711    !
    … …  
    719717    !   This routine only works if the variable does not exist or is constant
    720718    !
     719C     -----------------------------
     720
     721      iml = assert_eq((/size(lon_in), size(pls, 1), size(workvar, 1),
     722     $     size(champ, 1), size(lon_in2)/), "startget_dyn iml")
     723      jml = assert_eq(size(lat_in), size(pls, 2), size(workvar, 2),
     724     $     size(champ, 2), "startget_dyn jml")
     725      lml = assert_eq(size(pls, 3), size(workvar, 3), size(champ, 3),
     726     $     "startget_dyn lml")
     727      jml2 = size(lat_in2)
     728
    721729      IF ( MINVAL(champ(:,:,:)).EQ.MAXVAL(champ(:,:,:)) .AND.
    722730     . MINVAL(champ(:,:,:)).EQ.val_exp ) THEN
    … …  
    834842     ,             lat_in2 , interbar )
    835843    !
     844      use inter_barxy_m, only: inter_barxy
     845
    836846      INTEGER, INTENT(in) :: iml, jml, jml2
    837847      REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
    … …  
    929939        WRITE(6,*) '-------------------------------------------------',
    930940     ,'--------------'
    931         CALL inter_barxy ( iml_dyn,jml_dyn -1,lon_rad,lat_rad ,
    932      ,    var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var)
     941        CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana,
     942     $       lon_in2(:iml-1), lat_in2(:jml-1), tmp_var)
    933943      ELSE
    934944        CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
    … …  
    954964        WRITE(6,*) '-------------------------------------------------',
    955965     ,'--------------'
    956         CALL inter_barxy ( iml_dyn,jml_dyn -1,lon_rad,lat_rad ,
    957      ,    var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var)
     966        CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana,
     967     $       lon_in2(:iml-1), lat_in2(:jml-1), tmp_var)
    958968      ELSE
    959969        CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
    … …  
    10351045    !
    10361046    !
     1047      use inter_barxy_m, only: inter_barxy
     1048
    10371049    !    ARGUMENTS
    10381050    !
    … …  
    11201132     ,'--------------'
    11211133       ENDIF
    1122        CALL inter_barxy ( iml_dyn, jml_dyn -1,lon_rad, lat_rad,
    1123      , var_ana3d(:,:,il),iml-1, jml2, lon_in2, lat_in2,jml,var_tmp2d )
     1134       CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1),
     1135     $      var_ana3d(:,:,il), lon_in2(:iml-1), lat_in2, var_tmp2d)
    11241136      ELSE
    11251137       CALL grille_m(iml_dyn, jml_dyn, lon_rad, lat_rad,
Note: See TracChangeset for help on using the changeset viewer.