source: trunk/LMDZ.PLUTO.old/libf/dyn3d/poubelle/readhead_NC.F @ 3607

Last change on this file since 3607 was 3175, checked in by emillour, 13 months ago

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