Ignore:
Timestamp:
Oct 24, 2012, 9:10:10 AM (12 years ago)
Author:
Ehouarn Millour
Message:
  • fixed "aquaplanet case" so that initializations (creation of files startphy.nc and limit.nc) now also works in parallel (mpi,omp,mixed).
  • call to "iniaqua" is now done from within "iniphysiq" ; also added some tests to check consistency between essential variables shared by dynamics and physics (planetary radius, gravity, Cp, ...)
  • simillarily adapted "phydev" routines, and added necessary routines to also be able to generate startphy.nc/restartphy.nc files there. Also removed common file "comcstphy.h" and replaced it with a module "comcstphy.F90"

EM

Location:
LMDZ5/trunk/libf/phydev
Files:
4 added
1 deleted
3 edited

Legend:

Unmodified
Added
Removed
  • LMDZ5/trunk/libf/phydev/iniphysiq.F

    r1615 r1671  
    22! $Id: iniphysiq.F 1403 2010-07-01 09:02:53Z fairhead $
    33!
    4 c
    5 c
    64      SUBROUTINE iniphysiq(ngrid,nlayer,
    75     $           punjours,
    86     $           pdayref,ptimestep,
    97     $           plat,plon,parea,pcu,pcv,
    10      $           prad,pg,pr,pcpp)
    11       USE dimphy
    12       USE mod_grid_phy_lmdz
    13       USE mod_phys_lmdz_para
    14       USE comgeomphy
     8     $           prad,pg,pr,pcpp,iflag_phys)
     9      USE dimphy, only : klev
     10      USE mod_grid_phy_lmdz, only : klon_glo
     11      USE mod_phys_lmdz_para, only : klon_omp,klon_omp_begin,
     12     &                               klon_omp_end,klon_mpi_begin
     13      USE comgeomphy, only : airephy,cuphy,cvphy,rlond,rlatd
     14      USE comcstphy, only : rradius,rg,rr,rcpp
    1515
    1616      IMPLICIT NONE
     
    1818c=======================================================================
    1919c
    20 c   subject:
    21 c   --------
     20c   Initialisation of the physical constants and some positional and
     21c   geometrical arrays for the physics
    2222c
    23 c   Initialisation for the physical parametrisations of the LMD
    24 c   martian atmospheric general circulation modele.
    25 c
    26 c   author: Frederic Hourdin 15 / 10 /93
    27 c   -------
    28 c
    29 c   arguments:
    30 c   ----------
    31 c
    32 c   input:
    33 c   ------
    3423c
    3524c    ngrid                 Size of the horizontal grid.
     
    3726c    nlayer                Number of vertical layers.
    3827c    pdayref               Day of reference for the simulation
    39 c    firstcall             True at the first call
    40 c    lastcall              True at the last call
    41 c    pday                  Number of days counted from the North. Spring
    42 c                          equinoxe.
    4328c
    4429c=======================================================================
    45 c
    46 c-----------------------------------------------------------------------
    47 c   declarations:
    48 c   -------------
     30 
    4931 
    5032cym#include "dimensions.h"
    5133cym#include "dimphy.h"
    5234cym#include "comgeomphy.h"
    53 #include "comcstphy.h"
    54       REAL prad,pg,pr,pcpp,punjours
    55  
    56       INTEGER ngrid,nlayer
    57       REAL plat(ngrid),plon(ngrid),parea(klon_glo)
    58       REAL pcu(klon_glo),pcv(klon_glo)
    59       INTEGER pdayref
     35#include "iniprint.h"
     36
     37      REAL,INTENT(IN) :: prad ! radius of the planet (m)
     38      REAL,INTENT(IN) :: pg ! gravitational acceleration (m/s2)
     39      REAL,INTENT(IN) :: pr ! ! reduced gas constant R/mu
     40      REAL,INTENT(IN) :: pcpp ! specific heat Cp
     41      REAL,INTENT(IN) :: punjours ! length (in s) of a standard day
     42      INTEGER,INTENT(IN) :: ngrid ! number of horizontal grid points in the physics
     43      INTEGER,INTENT(IN) :: nlayer ! number of atmospheric layers
     44      REAL,INTENT(IN) :: plat(ngrid) ! latitudes of the physics grid
     45      REAL,INTENT(IN) :: plon(ngrid) ! longitudes of the physics grid
     46      REAL,INTENT(IN) :: parea(klon_glo) ! area (m2)
     47      REAL,INTENT(IN) :: pcu(klon_glo) ! cu coeff. (u_covariant = cu * u)
     48      REAL,INTENT(IN) :: pcv(klon_glo) ! cv coeff. (v_covariant = cv * v)
     49      INTEGER,INTENT(IN) :: pdayref ! reference day of for the simulation
     50      REAL,INTENT(IN) :: ptimestep !physics time step (s)
     51      INTEGER,INTENT(IN) :: iflag_phys ! type of physics to be called
     52
    6053      INTEGER :: ibegin,iend,offset
    61  
    62       REAL ptimestep
    6354      CHARACTER (LEN=20) :: modname='iniphysiq'
    6455      CHARACTER (LEN=80) :: abort_message
    6556 
    6657      IF (nlayer.NE.klev) THEN
    67          PRINT*,'STOP in inifis'
    68          PRINT*,'Probleme de dimensions :'
    69          PRINT*,'nlayer     = ',nlayer
    70          PRINT*,'klev   = ',klev
     58         write(lunout,*) 'STOP in ',trim(modname)
     59         write(lunout,*) 'Problem with dimensions :'
     60         write(lunout,*) 'nlayer     = ',nlayer
     61         write(lunout,*) 'klev   = ',klev
    7162         abort_message = ''
    7263         CALL abort_gcm (modname,abort_message,1)
     
    7465
    7566      IF (ngrid.NE.klon_glo) THEN
    76          PRINT*,'STOP in inifis'
    77          PRINT*,'Probleme de dimensions :'
    78          PRINT*,'ngrid     = ',ngrid
    79          PRINT*,'klon   = ',klon_glo
     67         write(lunout,*) 'STOP in ',trim(modname)
     68         write(lunout,*) 'Problem with dimensions :'
     69         write(lunout,*) 'ngrid     = ',ngrid
     70         write(lunout,*) 'klon   = ',klon_glo
    8071         abort_message = ''
    8172         CALL abort_gcm (modname,abort_message,1)
    8273      ENDIF
    83 c$OMP PARALLEL PRIVATE(ibegin,iend)
    84 c$OMP+         SHARED(parea,pcu,pcv,plon,plat)
     74
     75!$OMP PARALLEL PRIVATE(ibegin,iend)
     76!$OMP+         SHARED(parea,pcu,pcv,plon,plat)
    8577     
    8678      offset=klon_mpi_begin-1
     
    9284      rlatd(1:klon_omp)=plat(offset+klon_omp_begin:offset+klon_omp_end)
    9385
    94 !     call suphel
    95 !     prad,pg,pr,pcpp
     86! copy some fundamental parameters to physics
    9687      rradius=prad
    9788      rg=pg
     
    9990      rcpp=pcpp
    10091
    101      
     92!$OMP END PARALLEL
    10293
    103 c$OMP END PARALLEL
     94!      print*,'ATTENTION !!! TRAVAILLER SUR INIPHYSIQ'
     95!      print*,'CONTROLE DES LATITUDES, LONGITUDES, PARAMETRES ...'
    10496
    105       print*,'ATTENTION !!! TRAVAILLER SUR INIPHYSIQ'
    106       print*,'CONTROLE DES LATITUDES, LONGITUDES, PARAMETRES ...'
     97! Additional initializations for aquaplanets
     98!$OMP PARALLEL
     99      if (iflag_phys>=100) then
     100        call iniaqua(klon_omp,rlatd,rlond,iflag_phys)
     101      endif
     102!$OMP END PARALLEL
    107103
    108       RETURN
    109 9999  CONTINUE
    110       abort_message ='Cette version demande les fichier rnatur.dat
    111      & et surf.def'
    112       CALL abort_gcm (modname,abort_message,1)
     104!      RETURN
     105!9999  CONTINUE
     106!      abort_message ='Cette version demande les fichier rnatur.dat
     107!     & et surf.def'
     108!      CALL abort_gcm (modname,abort_message,1)
    113109
    114110      END
  • LMDZ5/trunk/libf/phydev/phyaqua.F

    r1615 r1671  
    1 ! Routines complementaires pour la physique planetaire.
    2 
     1!
     2! $Id: $
     3!
    34
    45      subroutine iniaqua(nlon,latfi,lonfi,iflag_phys)
    56
    67!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    7 !  Creation d'un etat initial et de conditions aux limites
    8 !  (resp startphy.nc et limit.nc) pour des configurations idealisees
    9 ! du modele LMDZ dans sa version terrestre.
    10 !  iflag_phys est un parametre qui controle
    11 !  iflag_phys = N 
    12 !    de 100 a 199 : aqua planetes avec SST forcees
    13 !                 N-100 determine le type de SSTs
    14 !    de 200 a 299 : terra planetes avec Ts calcule
    15 !       
     8!  Create an initial state (startphy.nc) for the physics
     9!  Usefull for idealised cases (e.g. aquaplanets or testcases)
    1610!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1711
     12      use phys_state_var_mod, only : rlat,rlon,
     13     &                               phys_state_var_init
     14      use mod_phys_lmdz_para, only : klon_omp
     15      use comgeomphy, only : rlond,rlatd
     16      implicit none
     17     
     18      integer,intent(in) :: nlon,iflag_phys
     19      real,intent(in) :: lonfi(nlon),latfi(nlon)
    1820
    19       integer nlon,iflag_phys
    20 cIM ajout latfi, lonfi
    21       REAL, DIMENSION (nlon) :: lonfi, latfi
     21! local variables
     22      real :: pi
     23
     24! initializations:
     25      pi=2.*asin(1.)
     26
     27      call phys_state_var_init()
     28
     29      rlat(1:klon_omp)=rlatd(1:klon_omp)*180./pi
     30      rlon(1:klon_omp)=rlond(1:klon_omp)*180./pi
    2231
    2332
    24       return
     33! Here you could create an initial condition for the physics
     34! ...
     35! ... fill in the fields...
     36! ...
     37! ... and create a "startphy.nc" file
     38!      CALL phyredem ("startphy.nc")
     39
    2540      end
    2641
  • LMDZ5/trunk/libf/phydev/physiq.F90

    r1615 r1671  
    1111     &            , PVteta)
    1212
    13       USE dimphy
    14       USE infotrac
    15       USE comgeomphy
     13      USE dimphy, only : klon,klev
     14      USE infotrac, only : nqtot
     15      USE comgeomphy, only : rlatd
     16      USE comcstphy, only : rg
    1617
    1718      IMPLICIT none
     
    5051!======================================================================
    5152#include "dimensions.h"
    52 #include "comcstphy.h"
     53!#include "comcstphy.h"
    5354
    5455      integer jjmp1
     
    101102    PARAMETER    ( longcles = 20 )
    102103
    103 real temp_newton(klon,klev)
     104real :: temp_newton(klon,klev)
    104105integer k
    105106logical, save :: first=.true.
     107!$OMP THREADPRIVATE(first)
    106108
    107109      REAL clesphy0( longcles      )
    108110
    109 d_u=0.
    110 d_v=0.
    111 d_t=0.
    112 d_qx=0.
    113 d_ps=0.
     111! initializations
     112if (first) then
     113! ...
    114114
    115      d_u(:,1)=-u(:,1)/86400.
    116      do k=1,klev
    117         temp_newton(:,k)=280.+cos(rlatd(:))*40.-pphi(:,k)/rg*6.e-3
    118         d_t(:,k)=(temp_newton(:,k)-t(:,k))/1.e5
    119      enddo
     115  first=.false.
     116endif
     117
     118! set all tendencies to zero
     119d_u(:,:)=0.
     120d_v(:,:)=0.
     121d_t(:,:)=0.
     122d_qx(:,:,:)=0.
     123d_ps(:)=0.
     124
     125! compute tendencies to return to the dynamics:
     126! "friction" on the first layer
     127d_u(:,1)=-u(:,1)/86400.
     128! newtonian rlaxation towards temp_newton()
     129do k=1,klev
     130  temp_newton(:,k)=280.+cos(rlatd(:))*40.-pphi(:,k)/rg*6.e-3
     131  d_t(:,k)=(temp_newton(:,k)-t(:,k))/1.e5
     132enddo
    120133
    121134
    122       print*,'COUCOU PHYDEV'
    123       return
    124       end
     135print*,'COUCOU PHYDEV'
     136
     137! if lastcall, then it is time to write "restartphy.nc" file
     138if (lafin) then
     139  call phyredem("restartphy.nc")
     140endif
     141
     142end
Note: See TracChangeset for help on using the changeset viewer.