source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/iniphysiq.F90 @ 4934

Last change on this file since 4934 was 1993, checked in by Ehouarn Millour, 11 years ago

OpenMP instruction syntax must be free form if source file is free form Fortran.

EM

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.8 KB
Line 
1
2! $Id: iniphysiq.F90 1993 2014-03-05 14:38:40Z abarral $
3
4
5
6SUBROUTINE iniphysiq(ngrid, nlayer, punjours, pdayref, ptimestep, plat, plon, &
7    parea, pcu, pcv, prad, pg, pr, pcpp, iflag_phys)
8  USE dimphy, ONLY: klev
9  USE mod_grid_phy_lmdz, ONLY: klon_glo
10  USE mod_phys_lmdz_para, ONLY: klon_omp, klon_omp_begin, klon_omp_end, &
11    klon_mpi_begin
12  USE comgeomphy, ONLY: airephy, cuphy, cvphy, rlond, rlatd
13  USE phyaqua_mod, ONLY: iniaqua
14  IMPLICIT NONE
15
16  ! =======================================================================
17
18  ! Initialisation of the physical constants and some positional and
19  ! geometrical arrays for the physics
20
21
22  ! ngrid                 Size of the horizontal grid.
23  ! All internal loops are performed on that grid.
24  ! nlayer                Number of vertical layers.
25  ! pdayref               Day of reference for the simulation
26
27  ! =======================================================================
28
29  ! ym#include "dimensions.h"
30  ! ym#include "dimphy.h"
31  ! ym#include "comgeomphy.h"
32  include "YOMCST.h"
33  include "iniprint.h"
34
35  REAL, INTENT (IN) :: prad ! radius of the planet (m)
36  REAL, INTENT (IN) :: pg ! gravitational acceleration (m/s2)
37  REAL, INTENT (IN) :: pr ! ! reduced gas constant R/mu
38  REAL, INTENT (IN) :: pcpp ! specific heat Cp
39  REAL, INTENT (IN) :: punjours ! length (in s) of a standard day
40  INTEGER, INTENT (IN) :: ngrid ! number of horizontal grid points in the physics
41  INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers
42  REAL, INTENT (IN) :: plat(ngrid) ! latitudes of the physics grid
43  REAL, INTENT (IN) :: plon(ngrid) ! longitudes of the physics grid
44  REAL, INTENT (IN) :: parea(klon_glo) ! area (m2)
45  REAL, INTENT (IN) :: pcu(klon_glo) ! cu coeff. (u_covariant = cu * u)
46  REAL, INTENT (IN) :: pcv(klon_glo) ! cv coeff. (v_covariant = cv * v)
47  INTEGER, INTENT (IN) :: pdayref ! reference day of for the simulation
48  REAL, INTENT (IN) :: ptimestep !physics time step (s)
49  INTEGER, INTENT (IN) :: iflag_phys ! type of physics to be called
50
51  INTEGER :: ibegin, iend, offset
52  CHARACTER (LEN=20) :: modname = 'iniphysiq'
53  CHARACTER (LEN=80) :: abort_message
54
55  IF (nlayer/=klev) THEN
56    WRITE (lunout, *) 'STOP in ', trim(modname)
57    WRITE (lunout, *) 'Problem with dimensions :'
58    WRITE (lunout, *) 'nlayer     = ', nlayer
59    WRITE (lunout, *) 'klev   = ', klev
60    abort_message = ''
61    CALL abort_gcm(modname, abort_message, 1)
62  END IF
63
64  IF (ngrid/=klon_glo) THEN
65    WRITE (lunout, *) 'STOP in ', trim(modname)
66    WRITE (lunout, *) 'Problem with dimensions :'
67    WRITE (lunout, *) 'ngrid     = ', ngrid
68    WRITE (lunout, *) 'klon   = ', klon_glo
69    abort_message = ''
70    CALL abort_gcm(modname, abort_message, 1)
71  END IF
72
73  !$OMP PARALLEL PRIVATE(ibegin,iend) &
74  !$OMP          SHARED(parea,pcu,pcv,plon,plat)
75
76  offset = klon_mpi_begin - 1
77  airephy(1:klon_omp) = parea(offset+klon_omp_begin:offset+klon_omp_end)
78  cuphy(1:klon_omp) = pcu(offset+klon_omp_begin:offset+klon_omp_end)
79  cvphy(1:klon_omp) = pcv(offset+klon_omp_begin:offset+klon_omp_end)
80  rlond(1:klon_omp) = plon(offset+klon_omp_begin:offset+klon_omp_end)
81  rlatd(1:klon_omp) = plat(offset+klon_omp_begin:offset+klon_omp_end)
82
83    ! suphel => initialize some physical constants (orbital parameters,
84    !           geoid, gravity, thermodynamical constants, etc.) in the
85    !           physics
86  CALL suphel
87
88  !$OMP END PARALLEL
89
90    ! check that physical constants set in 'suphel' are coherent
91    ! with values set in the dynamics:
92  IF (rday/=punjours) THEN
93    WRITE (lunout, *) 'iniphysiq: length of day discrepancy!!!'
94    WRITE (lunout, *) '  in the dynamics punjours=', punjours
95    WRITE (lunout, *) '   but in the physics RDAY=', rday
96    IF (abs(rday-punjours)>0.01) THEN
97        ! stop here if the relative difference is more than 1%
98      abort_message = 'length of day discrepancy'
99      CALL abort_gcm(modname, abort_message, 1)
100    END IF
101  END IF
102  IF (rg/=pg) THEN
103    WRITE (lunout, *) 'iniphysiq: gravity discrepancy !!!'
104    WRITE (lunout, *) '     in the dynamics pg=', pg
105    WRITE (lunout, *) '  but in the physics RG=', rg
106    IF (abs(rg-pg)>0.01) THEN
107        ! stop here if the relative difference is more than 1%
108      abort_message = 'gravity discrepancy'
109      CALL abort_gcm(modname, abort_message, 1)
110    END IF
111  END IF
112  IF (ra/=prad) THEN
113    WRITE (lunout, *) 'iniphysiq: planet radius discrepancy !!!'
114    WRITE (lunout, *) '   in the dynamics prad=', prad
115    WRITE (lunout, *) '  but in the physics RA=', ra
116    IF (abs(ra-prad)>0.01) THEN
117        ! stop here if the relative difference is more than 1%
118      abort_message = 'planet radius discrepancy'
119      CALL abort_gcm(modname, abort_message, 1)
120    END IF
121  END IF
122  IF (rd/=pr) THEN
123    WRITE (lunout, *) 'iniphysiq: reduced gas constant discrepancy !!!'
124    WRITE (lunout, *) '     in the dynamics pr=', pr
125    WRITE (lunout, *) '  but in the physics RD=', rd
126    IF (abs(rd-pr)>0.01) THEN
127        ! stop here if the relative difference is more than 1%
128      abort_message = 'reduced gas constant discrepancy'
129      CALL abort_gcm(modname, abort_message, 1)
130    END IF
131  END IF
132  IF (rcpd/=pcpp) THEN
133    WRITE (lunout, *) 'iniphysiq: specific heat discrepancy !!!'
134    WRITE (lunout, *) '     in the dynamics pcpp=', pcpp
135    WRITE (lunout, *) '  but in the physics RCPD=', rcpd
136    IF (abs(rcpd-pcpp)>0.01) THEN
137        ! stop here if the relative difference is more than 1%
138      abort_message = 'specific heat discrepancy'
139      CALL abort_gcm(modname, abort_message, 1)
140    END IF
141  END IF
142
143  ! Additional initializations for aquaplanets
144  !$OMP PARALLEL
145  IF (iflag_phys>=100) THEN
146    CALL iniaqua(klon_omp, rlatd, rlond, iflag_phys)
147  END IF
148  !$OMP END PARALLEL
149
150  ! RETURN
151  ! 9999  CONTINUE
152  ! abort_message ='Cette version demande les fichier rnatur.dat
153  ! & et surf.def'
154  ! CALL abort_gcm (modname,abort_message,1)
155
156END SUBROUTINE iniphysiq
Note: See TracBrowser for help on using the repository browser.