Ignore:
Timestamp:
Jun 5, 2015, 9:16:07 PM (10 years ago)
Author:
dcugnet
Message:

Initial states creation routines have been reorganized and simplified.
As far as possible, dynamics and physics related routines have been
separated.
Some routines have been converted to fortran 90 and repeated codes sections
have been "factorized".
Array/vector arguments have become implicit in some routines to avoid usage
of "dimensions.h" ; possible for routines with explicit interfaces and if
iim and jjm can be deduced from arguments sizes.

  • dynlonlat_phylonlat/ce0l.F90 calls now phylmd/etat0phys_netcdf.F90 and dyn3d/etat0dyn_netcdf.F90 that replace phylmd/etat0_netcdf.F90. start.nc and startphy.nc creations are now independant.
  • startvar.F90 has been suppressed ; corresponding operations have been simplified and embedded in etat0*_netcdf.F90 routines as internal procedures.
  • Routines converted to fortran 90 and "factorized":
    • dyn3d_common/conf_dat_m.F90 (replaces dyn3d_common/conf_dat2d.F

and dyn3d_common/conf_dat3d.F)

  • dyn3d/dynredem.F90 (replaces dyn3d/dynredem.F)
  • dyn3d/dynetat0.F90 (replaces dyn3d/dynetat0.F)
  • phylmd/grid_noro_m.F90 (replaces dyn3d_common/grid_noro.F)
  • dynlonlat_phylonlat/grid_atob_m.F90 (replaces dyn3d_common/grid_atob.F)
  • dyn3d_common/caldyn0.F90 (replaces dyn3d_common/caldyn0.F)
  • dyn3d_common/covcont.F90 (replaces dyn3d_common/covcont.F)
  • dyn3d_common/pression.F90 (replaces dyn3d_common/pression.F)
  • phylmd/phyredem.F90 and phylmd/limit_netcdf.F90 have been slightly factorized.

TO DO:

  • little fix needed in grid_noro_m.F90 ; untouched yet to ensure results are exactly the same as before. Unsmoothed orography is used to compute "zphi", but smoothed (should be unsmoothed) one is used at poles.
  • add the dyn3dmem versions of dynredem.F90 and dynetat0.F90 (dynredem_loc.F90 and dynetat0_loc.F90, untested yet).
  • test compilation in parallel mode for a single processor.
Location:
LMDZ5/trunk/libf/dynlonlat_phylonlat
Files:
1 added
1 edited

Legend:

Unmodified
Added
Removed

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

    r2248 r2293  
     1PROGRAM ce0l
    12!
    2 ! $Id$
    3 !
    4 !-------------------------------------------------------------------------------
    5 !
    6 PROGRAM ce0l
    73!-------------------------------------------------------------------------------
    84! Purpose: Calls etat0, creates initial states and limit_netcdf
    … …  
    1511!-------------------------------------------------------------------------------
    1612  USE control_mod
    17 #ifdef CPP_EARTH
    18 ! This prog. is designed to work for Earth
     13
     14!#ifdef CPP_EARTH
     15!! This prog. is designed to work for Earth
     16  USE etat0dyn
     17  USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR
     18  USE ioipsl, ONLY: ioconf_calendar, getin, flininfo, flinopen, flinget, flinclo
     19
     20#ifdef CPP_PHYS
     21  USE etat0phys
    1922  USE dimphy
    2023  USE comgeomphy
    2124  USE infotrac
    2225  USE indice_sol_mod
     26  USE test_disvert_m, ONLY: test_disvert
     27#endif
     28! of #ifdef CPP_PHYS
     29
     30!#endif
     31!! of #ifdef CPP_EARTH
     32
     33  IMPLICIT NONE
     34
     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
     42  include "dimensions.h"
     43  include "paramet.h"
     44  include "comconst.h"
     45  include "comvert.h"
     46  include "iniprint.h"
     47  include "temps.h"
     48  include "logic.h"
     49  REAL               :: masque(iip1,jjp1)             !--- CONTINENTAL MASK
     50  REAL               :: phis  (iip1,jjp1)             !--- GROUND GEOPOTENTIAL
     51  CHARACTER(LEN=256) :: modname, fmt, calnd           !--- CALENDAR TYPE
     52  LOGICAL            :: use_filtre_fft
     53  LOGICAL, PARAMETER :: interbar=.TRUE., extrap=.FALSE., oldice=.FALSE.
     54
     55!--- Local variables for ocean mask reading:
     56  INTEGER            :: nid_o2a, iml_omask, jml_omask, j
     57  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 (:,:)
     60  REAL               :: date, lev(1)
     61!-------------------------------------------------------------------------------
     62  modname="ce0l"
     63
     64!--- Constants
     65  pi     = 4. * ATAN(1.)
     66  rad    = 6371229.
     67  daysec = 86400.
     68  omeg   = 2.*pi/daysec
     69  g      = 9.8
     70  kappa  = 0.2857143
     71  cpp    = 1004.70885
     72  jmp1   = jjm + 1
     73  preff   = 101325.
     74  pa      = 50000.
     75
     76  CALL conf_gcm( 99, .TRUE. )
     77
     78  dtvr = daysec/FLOAT(day_step)
     79  WRITE(lunout,*)'dtvr',dtvr
     80
     81  CALL iniconst()
     82#ifdef CPP_PHYS
     83  IF(pressure_exner) CALL test_disvert
     84#endif
     85  CALL inigeom()
    2386
    2487#ifdef CPP_IOIPSL
    25   USE ioipsl, ONLY: ioconf_calendar, getin
    26 #else
    27   ! if not using IOIPSL, we still need to use (a local version of) getin
    28   use ioipsl_getincom, only: getin
    29 #endif
    30 
    31 #endif
    32   IMPLICIT NONE
    33 #ifndef CPP_EARTH
    34 #include "iniprint.h"
    35   WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
    36 #else
    37 !-------------------------------------------------------------------------------
    38 ! Local variables:
    39   LOGICAL, PARAMETER :: interbar=.TRUE., extrap=.FALSE., oldice=.FALSE.
    40 #include "dimensions.h"
    41 #include "paramet.h"
    42 !#include "indicesol.h"
    43 #include "iniprint.h"
    44 #include "temps.h"
    45 #include "logic.h"
    46   REAL,    DIMENSION(iip1,jjp1) :: masque
    47   CHARACTER(LEN=15)             :: calnd
    48   REAL,    DIMENSION(iip1,jjp1) :: phis ! geopotentiel au sol
    49   logical use_filtre_fft
    50 !-------------------------------------------------------------------------------
    51   CALL conf_gcm( 99, .TRUE. )
     88  calnd='gregorian'
     89  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)
     100  END SELECT
     101  WRITE(lunout,*)'CHOSEN CALENDAR: Earth '//TRIM(calnd)
     102#endif
    52103
    53104  use_filtre_fft=.FALSE.
    54105  CALL getin('use_filtre_fft',use_filtre_fft)
    55   IF (use_filtre_fft) THEN
    56      write(lunout, fmt = *) 'FFT filter is not available in the ' &
    57           // 'sequential version of the dynamics.'
    58      write(lunout, fmt = *) &
    59           "Your setting of variable use_filtre_fft is not used."
     106  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."
    60109  ENDIF
    61110
     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!*******************************************************************************
     117  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.
     121  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
    62157  CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
    63158  WRITE(lunout,*)'---> klon=',klon
    64159  CALL InitComgeomphy
    65 
    66 #ifdef CPP_IOIPSL
    67   SELECT CASE(calend)
    68     CASE('earth_360d');CALL ioconf_calendar('360d');      calnd='a 360 jours/an'
    69     CASE('earth_365d');CALL ioconf_calendar('noleap');    calnd='a 365 jours/an'
    70     CASE('earth_366d');CALL ioconf_calendar('366d');      calnd='bissextile'
    71     CASE('gregorian'); CALL ioconf_calendar('gregorian'); calnd='gregorien'
    72     CASE('standard');  CALL ioconf_calendar('gregorian'); calnd='gregorien'
    73     CASE('julian');    CALL ioconf_calendar('julian');    calnd='julien'
    74     CASE('proleptic_gregorian'); CALL ioconf_calendar('gregorian')
    75   !--- DC Bof...  => IOIPSL a mettre a jour: proleptic_gregorian /= gregorian
    76     CASE DEFAULT
    77       CALL abort_gcm('ce0l','Mauvais choix de calendrier',1)
    78   END SELECT
    79   WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre '//TRIM(calnd)
    80 #endif
    81160
    82161  IF (type_trac == 'inca') THEN
    … …  
    86165    WRITE(lunout,*)'nbtr =' , nbtr
    87166#endif
    88   END IF
    89 
    90   WRITE(lunout,'(//)')
    91   WRITE(lunout,*) '  *********************  '
    92   WRITE(lunout,*) '  ***  etat0_netcdf ***  '
    93   WRITE(lunout,*) '  *********************  '
    94   WRITE(lunout,'(//)')
    95   WRITE(lunout,*) ' interbar = ',interbar
    96   CALL etat0_netcdf(interbar,masque,phis,ok_etat0)
    97 
     167! of #ifdef INCA
     168  END IF
     169  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
     180
     181  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
    98192  IF(ok_limit) THEN
    99   WRITE(lunout,'(//)')
    100   WRITE(lunout,*) '  *********************  '
    101   WRITE(lunout,*) '  ***  Limit_netcdf ***  '
    102   WRITE(lunout,*) '  *********************  '
    103   WRITE(lunout,'(//)')
    104   CALL limit_netcdf(interbar,extrap,oldice,masque)
    105   END IF
    106 
    107  
     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
    108202  WRITE(lunout,'(//)')
    109203  WRITE(lunout,*) '  ***************************  '
    … …  
    113207  CALL grilles_gcm_netcdf_sub(masque,phis)
    114208
    115 #endif
     209!#endif
    116210! of #ifndef CPP_EARTH #else
    117211
Note: See TracChangeset for help on using the changeset viewer.