Ignore:
Timestamp:
Jun 5, 2015, 9:16:07 PM (9 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.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/phyredem.F90

    r2265 r2293  
    1 ! $Id$
    2 
    31SUBROUTINE phyredem (fichnom)
    4 
     2!
     3!-------------------------------------------------------------------------------
     4! Author: Z.X. Li (LMD/CNRS), 1993/08/18
     5!-------------------------------------------------------------------------------
     6! Purpose: Write restart state for physics.
     7!-------------------------------------------------------------------------------
    58  USE dimphy
    69  USE mod_grid_phy_lmdz
    … …  
    1922
    2023  IMPLICIT none
    21   !======================================================================
    22   ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
    23   ! Objet: Ecriture de l'etat de redemarrage pour la physique
    24   !======================================================================
    25   include "netcdf.inc"
     24
     25  include "iniprint.h"
    2626  include "dimsoil.h"
    2727  include "clesphys.h"
    … …  
    4949  INTEGER isoil, nsrf,isw
    5050  CHARACTER (len=7) :: str7
    51   CHARACTER (len=2) :: str2
     51  CHARACTER (len=256) :: nam, lnam
    5252  INTEGER           :: it, iiq
    5353
    … …  
    126126  CALL put_field("FSIC", "fraction glace mer", pctsrf(:, is_sic))
    127127
    128   DO nsrf = 1, nbsrf
    129      IF (nsrf.LE.99) THEN
    130         WRITE(str2, '(i2.2)') nsrf
    131         CALL put_field("TS"//str2, "Temperature de surface No."//str2, &
    132              ftsol(:, nsrf))
    133      ELSE
    134         PRINT*, "Trop de sous-mailles"
    135         call abort_gcm("phyredem", "", 1)
    136      ENDIF
    137   ENDDO
     128  IF(nbsrf>99) THEN
     129    PRINT*, "Trop de sous-mailles";  CALL abort_gcm("phyredem", "", 1)
     130  END IF
     131  IF(nsoilmx>99) THEN
     132    PRINT*, "Trop de sous-surfaces"; CALL abort_gcm("phyredem", "", 1)
     133  END IF
     134
     135  CALL put_field_srf1("TS","Temperature",ftsol(:,:))
    138136
    139137! ================== Albedo =======================================
    140138  print*,'PHYREDEM NOUVEAU'
    141   DO nsrf = 1, nbsrf
    142      DO isw=1, nsw
    143         IF (isw.LE.99 .AND. nsrf.LE.99) THEN
    144            WRITE(str7, '(i2.2, "srf", i2.2)') isw, nsrf
    145   print*,'PHYREDEM ',"A_dir_SW"//str7
    146            CALL put_field("A_dir_SW"//str7, "Albedo direct du sol bande "//str7, &
    147                 falb_dir(:, isw, nsrf))
    148            CALL put_field("A_dif_SW"//str7, "Albedo difus du sol bande "//str7, &
    149                 falb_dif(:, isw, nsrf))
    150         ELSE
    151            PRINT*, "Trop de couches"
    152            call abort_gcm("phyredem", "", 1)
    153         ENDIF
    154      ENDDO
    155   ENDDO
    156 
    157 ! ================== Tsoil =======================================
    158   DO nsrf = 1, nbsrf
    159      DO isoil=1, nsoilmx
    160         IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
    161            WRITE(str7, '(i2.2, "srf", i2.2)') isoil, nsrf
    162            CALL put_field("Tsoil"//str7, "Temperature du sol No."//str7, &
    163                 tsoil(:, isoil, nsrf))
    164         ELSE
    165            PRINT*, "Trop de couches"
    166            call abort_gcm("phyredem", "", 1)
    167         ENDIF
    168      ENDDO
    169   ENDDO
    170 
    171   DO nsrf = 1, nbsrf
    172      IF (nsrf.LE.99) THEN
    173         WRITE(str2, '(i2.2)') nsrf
    174         CALL put_field("QS"//str2, "Humidite de surface No."//str2, &
    175              qsurf(:, nsrf))
    176      ELSE
    177         PRINT*, "Trop de sous-mailles"
    178         call abort_gcm("phyredem", "", 1)
    179      ENDIF
    180   END DO
    181 
    182   CALL put_field("QSOL", "Eau dans le sol (mm)", qsol)
    183 
    184   DO nsrf = 1, nbsrf
    185      IF (nsrf.LE.99) THEN
    186         WRITE(str2, '(i2.2)') nsrf
    187         CALL put_field("EVAP"//str2, "Evaporation de surface No."//str2 &
    188              , fevap(:, nsrf))
    189      ELSE
    190         PRINT*, "Trop de sous-mailles"
    191         call abort_gcm("phyredem", "", 1)
    192      ENDIF
    193   ENDDO
    194 
    195   DO nsrf = 1, nbsrf
    196      IF (nsrf.LE.99) THEN
    197         WRITE(str2, '(i2.2)') nsrf
    198         CALL put_field("SNOW"//str2, "Neige de surface No."//str2, &
    199              snow(:, nsrf))
    200      ELSE
    201         PRINT*, "Trop de sous-mailles"
    202         call abort_gcm("phyredem", "", 1)
    203      ENDIF
    204   ENDDO
     139  CALL put_field_srf2("A_dir_SW","Albedo direct",falb_dir(:,:,:))
     140  CALL put_field_srf2("A_dif_SW","Albedo diffus",falb_dif(:,:,:))
     141
     142! ================== Tsoil =========================================
     143  CALL put_field_srf2("Tsoil","Temperature",tsoil(:,:,:))
     144
     145  CALL put_field_srf1("QS"  , "Humidite",qsurf(:,:))
     146
     147  CALL put_field     ("QSOL", "Eau dans le sol (mm)", qsol)
     148
     149  CALL put_field_srf1("EVAP", "Evaporation", fevap(:,:))
     150
     151  CALL put_field_srf1("SNOW", "Neige", fevap(:,:))
    205152
    206153  CALL put_field("RADS", "Rayonnement net a la surface", radsol)
    … …  
    218165  CALL put_field("snow_f", "precipitation solide", snow_fall)
    219166
    220   DO nsrf = 1, nbsrf
    221      IF (nsrf.LE.99) THEN
    222         WRITE(str2, '(i2.2)') nsrf
    223         CALL put_field("Z0m"//str2, "rugosite de surface No."//str2, &
    224              z0m(:, nsrf))
    225         CALL put_field("Z0h"//str2, "rugosite de surface No."//str2, &
    226              z0h(:, nsrf))
    227      ELSE
    228         PRINT*, "Trop de sous-mailles"
    229         call abort_gcm("phyredem", "", 1)
    230      ENDIF
    231   ENDDO
    232 
    233   DO nsrf = 1, nbsrf
    234      IF (nsrf.LE.99) THEN
    235         WRITE(str2, '(i2.2)') nsrf
    236         CALL put_field("AGESNO"//str2, &
    237              "Age de la neige surface No."//str2, &
    238              agesno(:, nsrf))
    239      ELSE
    240         PRINT*, "Trop de sous-mailles"
    241         call abort_gcm("phyredem", "", 1)
    242      ENDIF
    243   ENDDO
     167  CALL put_field_srf1("Z0m", "rugosite", z0m(:,:))
     168
     169  CALL put_field_srf1("Z0h", "rugosite", z0h(:,:))
     170
     171  CALL put_field_srf1("AGESNO", "Age de la neige", agesno(:,:))
    244172
    245173  CALL put_field("ZMEA", "ZMEA", zmea)
    … …  
    280208
    281209  IF (iflag_pbl>1) then
    282      DO nsrf = 1, nbsrf
    283         IF (nsrf.LE.99) THEN
    284            WRITE(str2, '(i2.2)') nsrf
    285            CALL put_field("TKE"//str2, "Energ. Cineti. Turb."//str2, &
    286                 pbl_tke(:, 1:klev+1, nsrf))
    287            CALL put_field("DELTATKE"//str2, "Del TKE wk/env."//str2, &
    288                 wake_delta_pbl_tke(:, 1:klev+1, nsrf))
    289         ELSE
    290            PRINT*, "Trop de sous-mailles"
    291            call abort_gcm("phyredem", "", 1)
    292         ENDIF
    293      ENDDO
    294   ENDIF
     210    CALL put_field_srf3("TKE", "Energ. Cineti. Turb.", &
     211         pbl_tke(:,:,:))
     212    CALL put_field_srf3("DELTATKE", "Del TKE wk/env.", &
     213         wake_delta_pbl_tke(:,:,:))
     214  END IF
    295215
    296216  ! FIN TKE PBL !
    … …  
    372292  !$OMP BARRIER
    373293
     294
     295  CONTAINS
     296
     297
     298SUBROUTINE put_field_srf1(nam,lnam,field)
     299
     300  IMPLICIT NONE
     301  CHARACTER(LEN=*),  INTENT(IN) :: nam, lnam
     302  REAL,              INTENT(IN) :: field(:,:)
     303  CHARACTER(LEN=256) :: nm, lm, str
     304  DO nsrf = 1, nbsrf
     305    WRITE(str, '(i2.2)') nsrf
     306    nm=TRIM(nam)//TRIM(str)
     307    lm=TRIM(lnam)//" de surface No. "//TRIM(str)
     308    CALL put_field(nm,lm,field(:,nsrf))
     309  END DO
     310
     311END SUBROUTINE put_field_srf1
     312
     313
     314SUBROUTINE put_field_srf2(nam,lnam,field)
     315
     316  IMPLICIT NONE
     317  CHARACTER(LEN=*),  INTENT(IN) :: nam, lnam
     318  REAL,              INTENT(IN) :: field(:,:,:)
     319  CHARACTER(LEN=256) :: nm, lm, str
     320  DO nsrf = 1, nbsrf
     321    DO isoil=1, nsw
     322      WRITE(str, '(i2.2,"srf",i2.2)')isoil,nsrf
     323!      WRITE(lunout,*)"PHYREDEM ",TRIM(nam)//TRIM(str)
     324      nm=TRIM(nam)//TRIM(str)
     325      lm=TRIM(lnam)//" du sol No. "//TRIM(str)
     326      CALL put_field(nm,lm,field(:,isoil,nsrf))
     327    END DO
     328  END DO
     329
     330END SUBROUTINE put_field_srf2
     331
     332
     333SUBROUTINE put_field_srf3(nam,lnam,field)
     334
     335  IMPLICIT NONE
     336  CHARACTER(LEN=*),  INTENT(IN) :: nam, lnam
     337  REAL,              INTENT(IN) :: field(:,:,:)
     338  CHARACTER(LEN=256) :: nm, lm, str
     339  DO nsrf = 1, nbsrf
     340    WRITE(str, '(i2.2)') nsrf
     341    nm=TRIM(nam)//TRIM(str)
     342    lm=TRIM(lnam)//TRIM(str)
     343    CALL put_field(nm,lm,field(:,1:klev+1,nsrf))
     344  END DO
     345
     346END SUBROUTINE put_field_srf3
     347
     348
    374349END SUBROUTINE phyredem
Note: See TracChangeset for help on using the changeset viewer.