My Project
 All Classes Files Functions Variables Macros
iniphysiq.F
Go to the documentation of this file.
1 !
2 ! $Id: iniphysiq.F 1403 2010-07-01 09:02:53Z fairhead $
3 !
4  SUBROUTINE iniphysiq(ngrid,nlayer,
5  $ punjours,
6  $ pdayref,ptimestep,
7  $ plat,plon,parea,pcu,pcv,
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
15 
16  IMPLICIT NONE
17 c
18 c=======================================================================
19 c
20 c Initialisation of the physical constants and some positional and
21 c geometrical arrays for the physics
22 c
23 c
24 c ngrid Size of the horizontal grid.
25 c All internal loops are performed on that grid.
26 c nlayer Number of vertical layers.
27 c pdayref Day of reference for the simulation
28 c
29 c=======================================================================
30 
31 
32 cym#include "dimensions.h"
33 cym#include "dimphy.h"
34 cym#include "comgeomphy.h"
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 
53  INTEGER :: ibegin,iend,offset
54  CHARACTER (LEN=20) :: modname='iniphysiq'
55  CHARACTER (LEN=80) :: abort_message
56 
57  IF (nlayer.NE.klev) THEN
58  write(lunout,*) 'STOP in ',trim(modname)
59  write(lunout,*) 'Problem with dimensions :'
60  write(lunout,*) 'nlayer = ',nlayer
61  write(lunout,*) 'klev = ',klev
62  abort_message = ''
63  CALL abort_gcm(modname,abort_message,1)
64  ENDIF
65 
66  IF (ngrid.NE.klon_glo) THEN
67  write(lunout,*) 'STOP in ',trim(modname)
68  write(lunout,*) 'Problem with dimensions :'
69  write(lunout,*) 'ngrid = ',ngrid
70  write(lunout,*) 'klon = ',klon_glo
71  abort_message = ''
72  CALL abort_gcm(modname,abort_message,1)
73  ENDIF
74 
75 !$OMP PARALLEL PRIVATE(ibegin,iend)
76 !$OMP+ SHARED(parea,pcu,pcv,plon,plat)
77 
78  offset=klon_mpi_begin-1
79  airephy(1:klon_omp)=parea(offset+klon_omp_begin:
80  & offset+klon_omp_end)
81  cuphy(1:klon_omp)=pcu(offset+klon_omp_begin:offset+klon_omp_end)
82  cvphy(1:klon_omp)=pcv(offset+klon_omp_begin:offset+klon_omp_end)
83  rlond(1:klon_omp)=plon(offset+klon_omp_begin:offset+klon_omp_end)
84  rlatd(1:klon_omp)=plat(offset+klon_omp_begin:offset+klon_omp_end)
85 
86 ! copy some fundamental parameters to physics
87  rradius=prad
88  rg=pg
89  rr=pr
90  rcpp=pcpp
91 
92 !$OMP END PARALLEL
93 
94 ! print*,'ATTENTION !!! TRAVAILLER SUR INIPHYSIQ'
95 ! print*,'CONTROLE DES LATITUDES, LONGITUDES, PARAMETRES ...'
96 
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
103 
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)
109 
110  END