source: trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/readhead_NC.F @ 2943

Last change on this file since 2943 was 1977, checked in by emillour, 6 years ago

Mars GCM:
Update xvik.F main program to work with current diagfi outputs.
EM

File size: 6.8 KB
Line 
1      SUBROUTINE readhead_NC (fichnom,
2     .           day0,
3     .           phis,constR)
4
5      USE comvert_mod, ONLY: aps,bps,preff
6      USE comconst_mod, ONLY: im,jm,lllm,daysec,dtvr,
7     .                  rad,omeg,g,cpp,kappa,r,pi
8      USE temps_mod, ONLY: day_ini
9      USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
10
11      IMPLICIT none
12c======================================================================
13c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
14c  Adaptation à Mars : Yann Wanherdrick
15c Objet: Lecture de l etat initial pour la physique
16c======================================================================
17#include "netcdf.inc"
18c====== includes de l ancien readhead ===
19#include "dimensions.h"
20#include "paramet.h"
21#include "comgeom.h"
22
23c======================================================================
24
25      CHARACTER*(*) fichnom
26      INTEGER nbsrf !Mars nbsrf a 1 au lieu de 4
27      PARAMETER (nbsrf=1) ! nombre de sous-fractions pour une maille
28
29      INTEGER radpas
30
31      REAL xmin, xmax
32c
33      INTEGER  i
34
35c   Variables
36c
37      INTEGER length,iq
38      PARAMETER (length = 100)
39      REAL tab_cntrl(length) ! tableau des parametres du run
40      INTEGER ierr, nid, nvarid
41      CHARACTER  str3*3
42
43c
44      INTEGER day0
45      REAL phis(ip1jmp1),constR
46c
47c Ouvrir le fichier contenant l etat initial:
48c
49      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
50      IF (ierr.NE.NF_NOERR) THEN
51        write(6,*)' Pb d''ouverture du fichier '//fichnom
52        CALL ABORT
53      ENDIF
54c
55c Lecture des parametres de controle:
56c
57      ierr = NF_INQ_VARID (nid, "controle", nvarid)
58      IF (ierr.NE.NF_NOERR) THEN
59         PRINT*, 'readhead_NC: Le champ <controle> est absent'
60         CALL abort
61      ENDIF
62#ifdef NC_DOUBLE
63      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
64#else
65      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
66#endif
67      IF (ierr.NE.NF_NOERR) THEN
68         PRINT*, 'readhead_NC: Lecture echouee pour <controle>'
69         CALL abort
70      ENDIF
71
72
73c Info sur la Planete Mars pour la dynamique
74      im         = tab_cntrl(1)
75      jm         = tab_cntrl(2)
76      lllm       = tab_cntrl(3)
77      day_ini    = tab_cntrl(4)
78      rad        = tab_cntrl(5)
79      omeg       = tab_cntrl(6)
80      g          = tab_cntrl(7)
81c      mugaz      = tab_cntrl(8)
82      cpp        =  744.499
83      kappa      = tab_cntrl(9)
84      daysec     = tab_cntrl(10)
85      dtvr       = tab_cntrl(11)
86      etot0      = tab_cntrl(12)
87      ptot0      = tab_cntrl(13)
88      ztot0      = tab_cntrl(14)
89      stot0      = tab_cntrl(15)
90      ang0       = tab_cntrl(16)
91c pas vrai pour diagfi, seulement pour start      preff      = tab_cntrl(18)
92      preff=610.
93      WRITE (*,*) 'readhead -     preff ' , preff
94c
95
96      day0=day_ini
97
98      constR=kappa*cpp
99      WRITE (*,*) 'constR = ' , constR
100      r=constR
101      IF(   im.ne.iim           )  THEN
102          PRINT 1,im,iim
103          STOP
104      ELSE  IF( jm.ne.jjm       )  THEN
105          PRINT 2,jm,jjm
106          STOP
107      ELSE  IF( lllm.ne.llm     )  THEN
108          PRINT 3,lllm,llm
109          STOP
110      ENDIF
111                                                                       
112      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
113      IF (ierr .NE. NF_NOERR) THEN
114         PRINT*, "readhead_NC: Le champ <longitude> est absent"
115         CALL abort
116      ENDIF
117#ifdef NC_DOUBLE
118      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
119#else
120      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
121#endif
122      IF (ierr .NE. NF_NOERR) THEN
123         PRINT*, "readhead_NC: Lecture echouee pour <longitude>"
124         CALL abort
125      ENDIF
126! convert it to radians
127      rlonu(:)=rlonu(:)*pi/180.
128
129      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
130      IF (ierr .NE. NF_NOERR) THEN
131         PRINT*, "readhead_NC: Le champ <latitude> est absent"
132         CALL abort
133      ENDIF
134#ifdef NC_DOUBLE
135      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
136#else
137      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
138#endif
139      IF (ierr .NE. NF_NOERR) THEN
140         PRINT*, "readhead_NC: Lecture echouee pour latitude"
141         CALL abort
142      ENDIF
143! convert it to radians
144      rlatv(:)=rlatv(:)*pi/180.
145
146!      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
147!      IF (ierr .NE. NF_NOERR) THEN
148!         PRINT*, "readhead_NC: Lecture echouee pour <cv>"
149!         CALL abort
150!      ENDIF
151c
152c Lecture des aires des mailles:
153c
154      ierr = NF_INQ_VARID (nid, "aire", nvarid)
155      IF (ierr.NE.NF_NOERR) THEN
156         PRINT*, 'readhead_NC: Le champ <aire> est absent'
157         CALL abort
158      ENDIF
159#ifdef NC_DOUBLE
160      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
161#else
162      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
163#endif
164      IF (ierr.NE.NF_NOERR) THEN
165         PRINT*, 'readhead_NC: Lecture echouee pour <aire>'
166         CALL abort
167      ENDIF
168      xmin = 1.0E+20
169      xmax = -1.0E+20
170      xmin = MINVAL(aire)
171      xmax = MAXVAL(aire)
172      PRINT*,'Aires des mailles <aire>:', xmin, xmax
173c
174c Lecture du geopotentiel au sol:
175c
176      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
177      IF (ierr.NE.NF_NOERR) THEN
178         PRINT*, 'readhead_NC: Le champ <phisinit> est absent'
179         CALL abort
180      ENDIF
181#ifdef NC_DOUBLE
182      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
183#else
184      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
185#endif
186      IF (ierr.NE.NF_NOERR) THEN
187         PRINT*, 'readhead_NC: Lecture echouee pour <phis>'
188         CALL abort
189      ENDIF
190c      PRINT*,'READHEAD_NC  Phis:',phis
191
192      ierr = NF_INQ_VARID (nid, "aps", nvarid)
193      IF (ierr .NE. NF_NOERR) THEN
194         PRINT*, "readhead_NC: Le champ <aps> est absent"
195         CALL abort
196      ENDIF
197#ifdef NC_DOUBLE
198      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aps)
199#else
200      ierr = NF_GET_VAR_REAL(nid, nvarid, aps)
201#endif
202      IF (ierr .NE. NF_NOERR) THEN
203         PRINT*, "readhead_NC: Lecture echouee pour <aps>"
204         CALL abort
205      ENDIF
206
207      ierr = NF_INQ_VARID (nid, "bps", nvarid)
208      IF (ierr .NE. NF_NOERR) THEN
209         PRINT*, "readhead_NC: Le champ <bps> est absent"
210         CALL abort
211      ENDIF
212#ifdef NC_DOUBLE
213      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bps)
214#else
215      ierr = NF_GET_VAR_REAL(nid, nvarid, bps)
216#endif
217      IF (ierr .NE. NF_NOERR) THEN
218         PRINT*, "readhead_NC: Lecture echouee pour <bps>"
219         CALL abort
220      ENDIF
221
222   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
223     *rrage est differente de la valeur parametree iim =',i4//)
224   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
225     *rrage est differente de la valeur parametree jjm =',i4//)
226   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier demar
227     *rage est differente de la valeur parametree llm =',i4//)
228   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier demar
229     *rage est differente de la valeur  dtinteg =',i4//)
230
231     
232c Fermer le fichier:
233c
234      ierr = NF_CLOSE(nid)
235c
236      RETURN
237      END
Note: See TracBrowser for help on using the repository browser.