Changeset 2331 for LMDZ5/trunk/libf


Ignore:
Timestamp:
Jul 17, 2015, 2:17:02 PM (9 years ago)
Author:
lguez
Message:

Fixed regression from revision 2315: comvert.h was replaced by
vertical_layers_mod in test_disvert, but variables ap, bp, preff of
vertical_layers_mod were not defined. So, in main program ce0l, moved
call to test_disvert after call to Init_Phys_lmdz, and inserted in
between them calls to infotrac_init and iniphysiq (required). Had then
to remove the call to infotrac_init in etat0dyn_netcdf. In main
program ce0l, had to remove the call to InitComgeomphy? since this is
done in iniphysiq.

In main program ce0l: no need to use indice_sol_mod; removed
preprocessor tests on CPP_PHYS in ce0l.

Location:
LMDZ5/trunk/libf/dynlonlat_phylonlat/phylmd
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/dynlonlat_phylonlat/phylmd/ce0l.F90

    r2293 r2331  
    11PROGRAM ce0l
    2 !
    3 !-------------------------------------------------------------------------------
    4 ! Purpose: Calls etat0, creates initial states and limit_netcdf
    5 !
    6 !     interbar=.T. for barycentric interpolation inter_barxy
    7 !     extrap  =.T. for data extrapolation, like for the SSTs when file does not
    8 !                  contain ocean points only.
    9 !     oldice  =.T. for old-style ice, obtained using grille_m (grid_atob).
    10 !     masque is created in etat0, passed to limit to ensure consistancy.
    11 !-------------------------------------------------------------------------------
    12   USE control_mod
    13 
    14 !#ifdef CPP_EARTH
    15 !! This prog. is designed to work for Earth
    16   USE etat0dyn
     2  !
     3  ! Purpose: Calls etat0, creates initial states and limit_netcdf
     4  !
     5  ! interbar=.T. for barycentric interpolation inter_barxy
     6  ! extrap  =.T. for data extrapolation, like for the SSTs when file does not
     7  !                  contain ocean points only.
     8  ! oldice  =.T. for old-style ice, obtained using grille_m (grid_atob).
     9  ! masque is created in etat0, passed to limit to ensure consistancy.
     10
     11  USE control_mod, only: DAY_STEP, DAYREF, NSPLIT_PHYS
     12  USE etat0dyn, only: etat0dyn_netcdf
    1713  USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR
    1814  USE ioipsl, ONLY: ioconf_calendar, getin, flininfo, flinopen, flinget, flinclo
    1915
    20 #ifdef CPP_PHYS
    21   USE etat0phys
    22   USE dimphy
    23   USE comgeomphy
    24   USE infotrac
    25   USE indice_sol_mod
     16  USE etat0phys, only: etat0phys_netcdf
     17  USE dimphy, only: KLON
     18  USE infotrac, only: TYPE_TRAC, infotrac_init
    2619  USE test_disvert_m, ONLY: test_disvert
    27 #endif
    28 ! of #ifdef CPP_PHYS
    29 
    30 !#endif
    31 !! of #ifdef CPP_EARTH
    3220
    3321  IMPLICIT NONE
    3422
    35 !-------------------------------------------------------------------------------
    36 ! Local variables:
    37 !#ifndef CPP_EARTH
    38 !  include "iniprint.h"
    39 !!-------------------------------------------------------------------------------
    40 !  WRITE(lunout,*)'ce0l: Earth-specific routine, needs Earth physics'
    41 !#else
     23  ! Local variables:
    4224  include "dimensions.h"
    4325  include "paramet.h"
     26  include "comgeom.h"
    4427  include "comconst.h"
    4528  include "comvert.h"
    … …  
    4730  include "temps.h"
    4831  include "logic.h"
    49   REAL               :: masque(iip1,jjp1)             !--- CONTINENTAL MASK
    50   REAL               :: phis  (iip1,jjp1)             !--- GROUND GEOPOTENTIAL
     32  REAL               :: masque(iip1, jjp1)             !--- CONTINENTAL MASK
     33  REAL               :: phis  (iip1, jjp1)             !--- GROUND GEOPOTENTIAL
    5134  CHARACTER(LEN=256) :: modname, fmt, calnd           !--- CALENDAR TYPE
    5235  LOGICAL            :: use_filtre_fft
    5336  LOGICAL, PARAMETER :: interbar=.TRUE., extrap=.FALSE., oldice=.FALSE.
    5437
    55 !--- Local variables for ocean mask reading:
     38  !--- Local variables for ocean mask reading:
    5639  INTEGER            :: nid_o2a, iml_omask, jml_omask, j
    5740  INTEGER            :: fid, iret, llm_tmp, ttm_tmp, itaul(1)
    58   REAL, ALLOCATABLE  :: lon_omask(:,:), dlon_omask(:), ocemask(:,:)
    59   REAL, ALLOCATABLE  :: lat_omask(:,:), dlat_omask(:), ocetmp (:,:)
     41  REAL, ALLOCATABLE  :: lon_omask(:, :), dlon_omask(:), ocemask(:, :)
     42  REAL, ALLOCATABLE  :: lat_omask(:, :), dlat_omask(:), ocetmp (:, :)
    6043  REAL               :: date, lev(1)
    61 !-------------------------------------------------------------------------------
     44
     45  !----------------------------------------------------------------------
    6246  modname="ce0l"
    6347
    64 !--- Constants
     48  !--- Constants
    6549  pi     = 4. * ATAN(1.)
    6650  rad    = 6371229.
    … …  
    7660  CALL conf_gcm( 99, .TRUE. )
    7761
    78   dtvr = daysec/FLOAT(day_step)
    79   WRITE(lunout,*)'dtvr',dtvr
     62  dtvr = daysec/REAL(day_step)
     63  WRITE(lunout, *)'dtvr', dtvr
    8064
    8165  CALL iniconst()
    82 #ifdef CPP_PHYS
    83   IF(pressure_exner) CALL test_disvert
    84 #endif
    8566  CALL inigeom()
    8667
    … …  
    8869  calnd='gregorian'
    8970  SELECT CASE(calend)
    90     CASE('earth_360d');CALL ioconf_calendar('360d');   calnd='with 360 days/year'
    91     CASE('earth_365d');CALL ioconf_calendar('noleap'); calnd='with no leap year'
    92     CASE('earth_366d');CALL ioconf_calendar('366d');   calnd='with leap years only'
    93     CASE('gregorian'); CALL ioconf_calendar('gregorian')
    94     CASE('standard');  CALL ioconf_calendar('gregorian')
    95     CASE('julian');    CALL ioconf_calendar('julian'); calnd='julian'
    96     CASE('proleptic_gregorian'); CALL ioconf_calendar('gregorian')
    97   !--- DC Bof...  => IOIPSL a mettre a jour: proleptic_gregorian /= gregorian
    98     CASE DEFAULT
    99       CALL abort_gcm('ce0l','Bad choice for calendar',1)
     71  CASE('earth_360d')
     72     CALL ioconf_calendar('360d')
     73     calnd='with 360 days/year'
     74  CASE('earth_365d')
     75     CALL ioconf_calendar('noleap')
     76     calnd='with no leap year'
     77  CASE('earth_366d')
     78     CALL ioconf_calendar('366d')
     79     calnd='with leap years only'
     80  CASE('gregorian')
     81     CALL ioconf_calendar('gregorian')
     82  CASE('standard')
     83     CALL ioconf_calendar('gregorian')
     84  CASE('julian')
     85     CALL ioconf_calendar('julian')
     86     calnd='julian'
     87  CASE('proleptic_gregorian')
     88     CALL ioconf_calendar('gregorian')
     89     !--- DC Bof...  => IOIPSL a mettre a jour: proleptic_gregorian /= gregorian
     90  CASE DEFAULT
     91     CALL abort_gcm('ce0l', 'Bad choice for calendar', 1)
    10092  END SELECT
    101   WRITE(lunout,*)'CHOSEN CALENDAR: Earth '//TRIM(calnd)
     93  WRITE(lunout, *)'CHOSEN CALENDAR: Earth '//TRIM(calnd)
    10294#endif
    10395
    10496  use_filtre_fft=.FALSE.
    105   CALL getin('use_filtre_fft',use_filtre_fft)
     97  CALL getin('use_filtre_fft', use_filtre_fft)
    10698  IF(use_filtre_fft) THEN
    107      WRITE(lunout,*)"FFT filter not available for sequential dynamics."
    108      WRITE(lunout,*)"Your setting of variable use_filtre_fft is not used."
     99     WRITE(lunout, *)"FFT filter not available for sequential dynamics."
     100     WRITE(lunout, *)"Your setting of variable use_filtre_fft is not used."
    109101  ENDIF
    110102
    111 !--- LAND MASK. TWO CASES:
    112 !   1) read from ocean model    file "o2a.nc"    (coupled runs)
    113 !   2) computed from topography file "Relief.nc" (masque(:,:)=-99999.)
    114 ! Coupled simulations (case 1) use the ocean model mask to compute the
    115 ! weights to ensure ocean fractions are the same for atmosphere and ocean.
    116 !*******************************************************************************
     103  !--- LAND MASK. TWO CASES:
     104  !   1) read from ocean model    file "o2a.nc"    (coupled runs)
     105  !   2) computed from topography file "Relief.nc" (masque(:, :)=-99999.)
     106  ! Coupled simulations (case 1) use the ocean model mask to compute the
     107  ! weights to ensure ocean fractions are the same for atmosphere and ocean.
     108
    117109  IF(NF90_OPEN("o2a.nc", NF90_NOWRITE, nid_o2a)/=NF90_NOERR) THEN
    118     WRITE(lunout,*)'BEWARE !! No ocean mask "o2a.nc" file found'
    119     WRITE(lunout,*)'Forced run.'
    120     masque(:,:)=-99999.
     110     WRITE(lunout, *)'BEWARE !! No ocean mask "o2a.nc" file found'
     111     WRITE(lunout, *)'Forced run.'
     112     masque(:, :)=-99999.
    121113  ELSE
    122     iret=NF90_CLOSE(nid_o2a)
    123     WRITE(lunout,*)'BEWARE !! Ocean mask "o2a.nc" file found'
    124     WRITE(lunout,*)'Coupled run.'
    125     CALL flininfo("o2a.nc", iml_omask, jml_omask, llm_tmp, ttm_tmp, nid_o2a)
    126     IF(iml_omask/=iim .OR.jml_omask/=jjp1) THEN
    127       WRITE(lunout,*)'Mismatching dimensions for ocean mask'
    128       WRITE(lunout,*)'iim  = ',iim ,' iml_omask = ',iml_omask
    129       WRITE(lunout,*)'jjp1 = ',jjp1,' jml_omask = ',jml_omask
    130       CALL abort_gcm(modname,'',1)
    131     END IF
    132     ALLOCATE(ocemask(iim,jjp1),lon_omask(iim,jjp1),dlon_omask(iim ))
    133     ALLOCATE(ocetmp (iim,jjp1),lat_omask(iim,jjp1),dlat_omask(jjp1))
    134     CALL flinopen("o2a.nc", .FALSE.,iim,jjp1,llm_tmp,lon_omask,lat_omask,lev,  &
    135      &                                       ttm_tmp,itaul,date,dt,fid)
    136     CALL flinget(fid, "OceMask",    iim,jjp1,llm_tmp,ttm_tmp,1,1,ocetmp)
    137     CALL flinclo(fid)
    138     dlon_omask(1:iim ) = lon_omask(1:iim,1)
    139     dlat_omask(1:jjp1) = lat_omask(1,1:jjp1)
    140     ocemask = ocetmp
    141     IF(dlat_omask(1)<dlat_omask(jml_omask)) THEN
    142       DO j=1,jjp1; ocemask(:,j) = ocetmp(:,jjp1-j+1); END DO
    143     END IF
    144     DEALLOCATE(ocetmp,lon_omask,lat_omask,dlon_omask,dlat_omask)
    145     IF(prt_level>=1) THEN
    146       WRITE(fmt,"(i4,'i1)')")iim ; fmt='('//ADJUSTL(fmt)
    147       WRITE(lunout,*)'OCEAN MASK :'
    148       WRITE(lunout,fmt) NINT(ocemask)
    149     END IF
    150     masque(1:iim,:)=1.-ocemask(:,:)
    151     masque(iip1 ,:)=masque(1,:)
    152     DEALLOCATE(ocemask)
    153   END IF
    154   phis(:,:)=-99999.
    155 
    156 #ifdef CPP_PHYS
    157   CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
    158   WRITE(lunout,*)'---> klon=',klon
    159   CALL InitComgeomphy
     114     iret=NF90_CLOSE(nid_o2a)
     115     WRITE(lunout, *)'BEWARE !! Ocean mask "o2a.nc" file found'
     116     WRITE(lunout, *)'Coupled run.'
     117     CALL flininfo("o2a.nc", iml_omask, jml_omask, llm_tmp, ttm_tmp, nid_o2a)
     118     IF(iml_omask/=iim .OR.jml_omask/=jjp1) THEN
     119        WRITE(lunout, *)'Mismatching dimensions for ocean mask'
     120        WRITE(lunout, *)'iim  = ', iim , ' iml_omask = ', iml_omask
     121        WRITE(lunout, *)'jjp1 = ', jjp1, ' jml_omask = ', jml_omask
     122        CALL abort_gcm(modname, '', 1)
     123     END IF
     124     ALLOCATE(ocemask(iim, jjp1), lon_omask(iim, jjp1), dlon_omask(iim ))
     125     ALLOCATE(ocetmp (iim, jjp1), lat_omask(iim, jjp1), dlat_omask(jjp1))
     126     CALL flinopen("o2a.nc", .FALSE., iim, jjp1, llm_tmp, lon_omask, &
     127          lat_omask, lev, ttm_tmp, itaul, date, dt, fid)
     128     CALL flinget(fid, "OceMask",    iim, jjp1, llm_tmp, ttm_tmp, 1, 1, ocetmp)
     129     CALL flinclo(fid)
     130     dlon_omask(1:iim ) = lon_omask(1:iim, 1)
     131     dlat_omask(1:jjp1) = lat_omask(1, 1:jjp1)
     132     ocemask = ocetmp
     133     IF(dlat_omask(1)<dlat_omask(jml_omask)) THEN
     134        DO j=1, jjp1
     135           ocemask(:, j) = ocetmp(:, jjp1-j+1)
     136        END DO
     137     END IF
     138     DEALLOCATE(ocetmp, lon_omask, lat_omask, dlon_omask, dlat_omask)
     139     IF(prt_level>=1) THEN
     140        WRITE(fmt, "(i4, 'i1)')")iim
     141        fmt='('//ADJUSTL(fmt)
     142        WRITE(lunout, *)'OCEAN MASK :'
     143        WRITE(lunout, fmt) NINT(ocemask)
     144     END IF
     145     masque(1:iim, :)=1.-ocemask(:, :)
     146     masque(iip1 , :)=masque(1, :)
     147     DEALLOCATE(ocemask)
     148  END IF
     149  phis(:, :)=-99999.
     150
     151  CALL Init_Phys_lmdz(iim, jjp1, llm, 1, (/(jjm-1)*iim+2/))
     152  WRITE(lunout, *)'---> klon=', klon
     153
     154  call infotrac_init
     155  CALL iniphysiq(iim, jjm, llm, daysec, dayref, dtphys / nsplit_phys, rlatu, &
     156       rlonv, aire, cu, cv, rad, g, r, cpp, iflag_phys)
     157
     158  IF(pressure_exner) CALL test_disvert
    160159
    161160  IF (type_trac == 'inca') THEN
    162161#ifdef INCA
    163     CALL init_const_lmdz(nbtr,anneeref,dayref,iphysiq,day_step,nday)
    164     CALL init_inca_para(iim,jjm+1,klon,1,klon_mpi_para_nb,0)
    165     WRITE(lunout,*)'nbtr =' , nbtr
     162     CALL init_const_lmdz(nbtr, anneeref, dayref, iphysiq, day_step, nday)
     163     CALL init_inca_para(iim, jjm+1, klon, 1, klon_mpi_para_nb, 0)
     164     WRITE(lunout, *)'nbtr =' , nbtr
    166165#endif
    167 ! of #ifdef INCA
    168166  END IF
    169167  IF(ok_etat0) THEN
    170     WRITE(lunout,'(//)')
    171     WRITE(lunout,*) '  ************************  '
    172     WRITE(lunout,*) '  ***  etat0phy_netcdf ***  '
    173     WRITE(lunout,*) '  ************************  '
    174     WRITE(lunout,'(//)')
    175     WRITE(lunout,*) ' interbar = ',interbar
    176     CALL etat0phys_netcdf(interbar,masque,phis)
    177   END IF
    178 #endif
    179 ! of #ifdef CPP_PHYS
     168     WRITE(lunout, '(//)')
     169     WRITE(lunout, *) '  ************************  '
     170     WRITE(lunout, *) '  ***  etat0phy_netcdf ***  '
     171     WRITE(lunout, *) '  ************************  '
     172     WRITE(lunout, '(//)')
     173     WRITE(lunout, *) ' interbar = ', interbar
     174     CALL etat0phys_netcdf(interbar, masque, phis)
     175  END IF
    180176
    181177  IF(ok_etat0) THEN
    182     WRITE(lunout,'(//)')
    183     WRITE(lunout,*) '  ************************  '
    184     WRITE(lunout,*) '  ***  etat0dyn_netcdf ***  '
    185     WRITE(lunout,*) '  ************************  '
    186     WRITE(lunout,'(//)')
    187     WRITE(lunout,*) ' interbar = ',interbar
    188     CALL etat0dyn_netcdf(interbar,masque,phis)
    189   END IF
    190 
    191 #ifdef CPP_PHYS
     178     WRITE(lunout, '(//)')
     179     WRITE(lunout, *) '  ************************  '
     180     WRITE(lunout, *) '  ***  etat0dyn_netcdf ***  '
     181     WRITE(lunout, *) '  ************************  '
     182     WRITE(lunout, '(//)')
     183     WRITE(lunout, *) ' interbar = ', interbar
     184     CALL etat0dyn_netcdf(interbar, masque, phis)
     185  END IF
     186
    192187  IF(ok_limit) THEN
    193     WRITE(lunout,'(//)')
    194     WRITE(lunout,*) '  *********************  '
    195     WRITE(lunout,*) '  ***  Limit_netcdf ***  '
    196     WRITE(lunout,*) '  *********************  '
    197     WRITE(lunout,'(//)')
    198     CALL limit_netcdf(interbar,extrap,oldice,masque)
    199   END IF
    200 #endif
    201 
    202   WRITE(lunout,'(//)')
    203   WRITE(lunout,*) '  ***************************  '
    204   WRITE(lunout,*) '  ***  grilles_gcm_netcdf ***  '
    205   WRITE(lunout,*) '  ***************************  '
    206   WRITE(lunout,'(//)')
    207   CALL grilles_gcm_netcdf_sub(masque,phis)
    208 
    209 !#endif
    210 ! of #ifndef CPP_EARTH #else
     188     WRITE(lunout, '(//)')
     189     WRITE(lunout, *) '  *********************  '
     190     WRITE(lunout, *) '  ***  Limit_netcdf ***  '
     191     WRITE(lunout, *) '  *********************  '
     192     WRITE(lunout, '(//)')
     193     CALL limit_netcdf(interbar, extrap, oldice, masque)
     194  END IF
     195
     196  WRITE(lunout, '(//)')
     197  WRITE(lunout, *) '  ***************************  '
     198  WRITE(lunout, *) '  ***  grilles_gcm_netcdf ***  '
     199  WRITE(lunout, *) '  ***************************  '
     200  WRITE(lunout, '(//)')
     201  CALL grilles_gcm_netcdf_sub(masque, phis)
    211202
    212203END PROGRAM ce0l
    213 !
    214 !-------------------------------------------------------------------------------

  • LMDZ5/trunk/libf/dynlonlat_phylonlat/phylmd/etat0dyn_netcdf.F90

    r2302 r2331  
    8383  USE exner_hyb_m,    ONLY: exner_hyb
    8484  USE exner_milieu_m, ONLY: exner_milieu
    85   USE infotrac
     85  USE infotrac, only: NQTOT, TNAME
    8686  USE filtreg_mod
    8787  IMPLICIT NONE
    … …  
    113113! Initializations for tracers and filter
    114114!*******************************************************************************
    115   CALL infotrac_init
    116115  CALL inifilr()
    117116

  • LMDZ5/trunk/libf/dynlonlat_phylonlat/phylmd/iniphysiq.F90

    r2320 r2331  
    7575
    7676  IF (nlayer/=klev) THEN
    77     WRITE (lunout, *) 'STOP in ', trim(modname)
    78     WRITE (lunout, *) 'Problem with dimensions :'
    7977    WRITE (lunout, *) 'nlayer     = ', nlayer
    8078    WRITE (lunout, *) 'klev   = ', klev
    81     abort_message = ''
    82     CALL abort_gcm(modname, abort_message, 1)
     79    CALL abort_gcm(modname, 'Problem with dimensions', 1)
    8380  END IF
    8481
Note: See TracChangeset for help on using the changeset viewer.