Ignore:
Timestamp:
Jun 15, 2015, 8:48:31 PM (10 years ago)
Author:
dcugnet
Message:

In dyn3d/:
etat0dyn_netcdf.F90: "startget_dyn3d" syntax slightly simplified.
dynredem.F90: Shortcut routines (put_var*, cre_var,
dynredem_write_*, dynredem_read_u)

modified to match dyn3dmem version and put in

module dyredem_mod.F90.
dynetat0.F90 -> *.f90: Few simplifications (no usage of NC_DOUBLE
needed => no precompilation)

Add tracers initialization in the isotope case

suppressed by accident.
dynredem_mod.F90: Created to mimic dyn3dmem equivalent.

In dyn3dmem/:
dynetat0_loc.F -> *.f90: Converted into fortran 90 to match the dyn3d
version.
dynredem_loc.F -> *.F90: Converted into fortran 90.
dynredem_mod.F90: Add some shortcut routines to match the dyn3d
version.

In phylmd/:
phyredem.F90: Bug fix: nsw instead of nsoilmx was used as
Tsoil second maximum index.

Bug fix: fevap instead of snow was saved for

"SNOW".
etat0phys_netcdf.F90: "filtreg_mod" module usage suppressed.

Local variable rugo computation removed (not

used).

In dynlonlat_phylonlat/:
grid_atob_m.F90 -> *.f90 DOUBLE PRECISION variables usage removed.

Precompilation o longer needed => .F90 extension.

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/dynlonlat_phylonlat/grid_atob_m.f90

    r2298 r2299  
    2121!-------------------------------------------------------------------------------
    2222! Arguments:
    23   REAL,                       INTENT(IN)  :: x_i(:), y_i(:)  !- IN  X&Y COORD.
    24   REAL,                       INTENT(IN)  :: x_o(:), y_o(:)  !- OUT X&Y COORD.
    25   DOUBLE PRECISION,           INTENT(OUT) :: d_o1(:,:)       !- OUT FLD (mo,no)
    26   REAL,             OPTIONAL, INTENT(IN)  :: d_i (:,:)       !- INP FLD (mi,ni)
    27   LOGICAL,          OPTIONAL, INTENT(IN)  :: msk (:,:)       !- MASK    (mi,ni)
    28   DOUBLE PRECISION, OPTIONAL, INTENT(OUT) :: d_o2(:,:)       !- OUT FOR d_i^2
     23  REAL,              INTENT(IN)  :: x_i(:), y_i(:) !-- INPUT  X&Y COOR. (mi)(ni)
     24  REAL,              INTENT(IN)  :: x_o(:), y_o(:) !-- OUTPUT X&Y COOR. (mi)(ni)
     25  REAL,              INTENT(OUT) :: d_o1(:,:)      !-- OUTPUT FIELD    (mo,no)
     26  REAL,    OPTIONAL, INTENT(IN)  :: d_i (:,:)      !-- INPUT FIELD      (mi,ni)
     27  LOGICAL, OPTIONAL, INTENT(IN)  :: msk (:,:)      !-- MASK             (mi,ni)
     28  REAL,    OPTIONAL, INTENT(OUT) :: d_o2(:,:)      !-- OUTPUT FOR d_i^2 (mo,no)
    2929!-------------------------------------------------------------------------------
    3030! Local variables:
    3131  CHARACTER(LEN=256) :: modname="fine2coarse"
    32   DOUBLE PRECISION   :: inc
    3332  INTEGER :: mi, ni, ii, ji, mo, no, io, jo, nr(2), m1, n1, m2, n2, nn
    3433  INTEGER :: num_tot(SIZE(x_o),SIZE(y_o))
    … …  
    3635  LOGICAL :: mask (SIZE(x_i),SIZE(y_i)), lo
    3736  REAL    :: dist (SIZE(x_o),SIZE(y_o))
    38   REAL    :: a(SIZE(x_o)), b(SIZE(x_o)), c(SIZE(y_o)), d(SIZE(y_o))
     37  REAL    :: a(SIZE(x_o)), b(SIZE(x_o)), c(SIZE(y_o)), d(SIZE(y_o)), inc
    3938  REAL, PARAMETER :: thresh=1.E-5
    4039!-------------------------------------------------------------------------------
    … …  
    5655
    5756!--- ACCUMULATE INPUT POINTS ON OUTPUT GRID
    58   d_o1(:,:)=0.; num_tot(:,:)=0; inc=1.0d0
     57  d_o1(:,:)=0.; num_tot(:,:)=0; inc=1.0
    5958  IF(lo) d_o2(:,:)=0.
    6059  DO ji = 1, ni
    6160    DO ii = 1, mi
    62       IF(li) inc=DBLE(d_i(ii,ji))
     61      IF(li) inc=d_i(ii,ji)
    6362      DO jo = 1, no
    6463        IF((y_i(ji)-c(jo)<thresh.OR.y_i(ji)-d(jo)>thresh).AND.   &
    … …  
    7877!--- CHECK INPUT POINTS HAVE BEEN FOUND IN EACH OUTPUT CELL
    7978  found(:,:)=num_tot(:,:)/=0
    80   WHERE(found.AND.mask) d_o1(:,:)=d_o1(:,:)/DBLE(num_tot(:,:))
     79  WHERE(found.AND.mask) d_o1(:,:)=d_o1(:,:)/REAL(num_tot(:,:))
    8180  IF(PRESENT(d_o2)) THEN
    82     WHERE(found.AND.mask) d_o2(:,:)=d_o2(:,:)/DBLE(num_tot(:,:))
     81    WHERE(found.AND.mask) d_o2(:,:)=d_o2(:,:)/REAL(num_tot(:,:))
    8382    RETURN
    8483  END IF
    … …  
    9291      CALL dist_sphe(x_o(io),y_o(jo),x_i,y_i,dist(:,:))
    9392      nr=MINLOC(dist(:,:))!; IF(prt_level>=1) PRINT*, "Solution: ", nr
    94       inc=1.0; IF(li) inc=DBLE(d_i(nr(1),nr(2)))
     93      inc=1.0; IF(li) inc=d_i(nr(1),nr(2))
    9594      IF(mask(nr(1),nr(2))) d_o1(io,jo)=inc
    9695    END DO
    … …  
    133132  REAL, INTENT(OUT) :: sortie(SIZE(x),SIZE(y))  !--- OUTPUT FIELD
    134133!-------------------------------------------------------------------------------
    135 ! Local variable:
    136   DOUBLE PRECISION  :: out(SIZE(x),SIZE(y))
    137 !-------------------------------------------------------------------------------
    138 !  CALL fine2coarse(xdata,ydata,x,y,out,DBLE(entree))
    139   CALL fine2coarse(xdata,ydata,x,y,out,entree)
    140   sortie=REAL(out)
     134  CALL fine2coarse(xdata,ydata,x,y,sortie,entree)
    141135
    142136END SUBROUTINE grille_m
    … …  
    152146! Author:  Z.X. Li (april 1st 1994)
    153147!-------------------------------------------------------------------------------
    154 ! Purpose: From topography field, compute ocean/land mask (land: 1 ; ocean: 0)
     148! Purpose: Remap rugosity length ; constant value (0.001) on oceans.
    155149! Naive method  (see grille_m)
    156150!-------------------------------------------------------------------------------
    … …  
    164158  REAL, INTENT(IN)  :: mask  (SIZE(x),SIZE(y)) !--- MASK
    165159!-------------------------------------------------------------------------------
    166 ! Local variable:
    167   DOUBLE PRECISION  :: out   (SIZE(x),SIZE(y))
    168 !-------------------------------------------------------------------------------
    169   CALL fine2coarse(xdata,ydata,x,y,out,LOG(entree))
     160  CALL fine2coarse(xdata,ydata,x,y,sortie,LOG(entree))
    170161  WHERE(NINT(mask)==1)
    171     out(:,:)=EXP(out(:,:))
     162    sortie(:,:)=EXP(sortie(:,:))
    172163  ELSE WHERE
    173     out(:,:)=0.001
     164    sortie(:,:)=0.001
    174165  END WHERE
    175   sortie=REAL(out)
    176166
    177167END SUBROUTINE rugosite
    … …  
    198188  REAL, INTENT(OUT) :: frac_ice(SIZE(x),SIZE(y)) !--- OUTPUT FIELD
    199189!-------------------------------------------------------------------------------
    200 ! Local variable:
    201   DOUBLE PRECISION  :: out     (SIZE(x),SIZE(y))
    202 !-------------------------------------------------------------------------------
    203   CALL fine2coarse(xdata,ydata,x,y,out,msk=NINT(glace01)==1)
    204   frac_ice=REAL(out)
     190  CALL fine2coarse(xdata,ydata,x,y,frac_ice,msk=NINT(glace01)==1)
    205191
    206192END SUBROUTINE sea_ice
    … …  
    228214  INTEGER           :: k, nn
    229215  INTEGER, PARAMETER:: itmp=360, jtmp=180
    230   DOUBLE PRECISION  :: out(SIZE(xmod),SIZE(xmod)), amin, amax
    231   DOUBLE PRECISION  :: cham1tmp(itmp,jtmp), cham2tmp(itmp,jtmp)
    232   REAL              :: xtmp(itmp), ytmp(jtmp)
     216  REAL  :: out(SIZE(xmod),SIZE(xmod)), amin, amax
     217  REAL  :: cham1tmp(itmp,jtmp), cham2tmp(itmp,jtmp), xtmp(itmp), ytmp(jtmp)
    233218!-------------------------------------------------------------------------------
    234219
    … …  
    245230  nn=COUNT(cham2tmp<0)
    246231  IF(nn/=0) PRINT*,'Problem for rugsoro ; std**2 < 0. for several points: ',nn
    247   WHERE(cham2tmp<0.0) cham2tmp=0.0d0
     232  WHERE(cham2tmp<0.0) cham2tmp=0.0
    248233  cham2tmp(:,:)=SQRT(cham2tmp(:,:))
    249234  amin=MINVAL(cham2tmp); amax=MAXVAL(cham2tmp)
    … …  
    251236
    252237!--- COMPUTE RUGOSITY AT REQUIRED SCALE
    253   WHERE(cham2tmp<0.001d0) cham2tmp=0.001d0
     238  WHERE(cham2tmp<0.001) cham2tmp=0.001
    254239  CALL fine2coarse(xtmp,ytmp,xmod,ymod,out,REAL(LOG(cham2tmp)))
    255240  out=EXP(out)
    256241  amin=MINVAL(out); amax=MAXVAL(out)
    257242  PRINT*, 'Ecart-type du modele:', amin, amax
    258   out=out/amax*20.0d0
     243  out=out/amax*20.0
    259244  amin=MINVAL(out); amax=MAXVAL(out)
    260245  PRINT*, 'Longueur de rugosite du modele:', amin, amax
Note: See TracChangeset for help on using the changeset viewer.