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