source: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/readhead_NC.F @ 1662

Last change on this file since 1662 was 1422, checked in by milmd, 10 years ago

In GENERIC, MARS and COMMON models replace some include files by modules (usefull for decoupling physics with dynamics).
File size: 6.7 KB
RevLine 
[38]1      SUBROUTINE readhead_NC (fichnom,
2     .           day0,
3     .           phis,constR)
[1422]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
8      USE temps_mod, ONLY: day_ini
9      USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
10
[38]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, "rlonu", nvarid)
113      IF (ierr .NE. NF_NOERR) THEN
114         PRINT*, "readhead_NC: Le champ <rlonu> 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 <rlonu>"
124         CALL abort
125      ENDIF
126                                                                       
127      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
128      IF (ierr .NE. NF_NOERR) THEN
129         PRINT*, "readhead_NC: Le champ <rlatv> est absent"
130         CALL abort
131      ENDIF
132#ifdef NC_DOUBLE
133      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
134#else
135      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
136#endif
137      IF (ierr .NE. NF_NOERR) THEN
138         PRINT*, "readhead_NC: Lecture echouee pour rlatv"
139         CALL abort
140      ENDIF
141
142      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
143      IF (ierr .NE. NF_NOERR) THEN
144         PRINT*, "readhead_NC: Lecture echouee pour <cv>"
145         CALL abort
146      ENDIF
147c
148c Lecture des aires des mailles:
149c
150      ierr = NF_INQ_VARID (nid, "aire", nvarid)
151      IF (ierr.NE.NF_NOERR) THEN
152         PRINT*, 'readhead_NC: Le champ <aire> est absent'
153         CALL abort
154      ENDIF
155#ifdef NC_DOUBLE
156      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
157#else
158      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
159#endif
160      IF (ierr.NE.NF_NOERR) THEN
161         PRINT*, 'readhead_NC: Lecture echouee pour <aire>'
162         CALL abort
163      ENDIF
164      xmin = 1.0E+20
165      xmax = -1.0E+20
166      xmin = MINVAL(aire)
167      xmax = MAXVAL(aire)
168      PRINT*,'Aires des mailles <aire>:', xmin, xmax
169c
170c Lecture du geopotentiel au sol:
171c
172      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
173      IF (ierr.NE.NF_NOERR) THEN
174         PRINT*, 'readhead_NC: Le champ <phisinit> est absent'
175         CALL abort
176      ENDIF
177#ifdef NC_DOUBLE
178      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
179#else
180      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
181#endif
182      IF (ierr.NE.NF_NOERR) THEN
183         PRINT*, 'readhead_NC: Lecture echouee pour <phis>'
184         CALL abort
185      ENDIF
186c      PRINT*,'READHEAD_NC  Phis:',phis
187
188      ierr = NF_INQ_VARID (nid, "aps", nvarid)
189      IF (ierr .NE. NF_NOERR) THEN
190         PRINT*, "readhead_NC: Le champ <aps> est absent"
191         CALL abort
192      ENDIF
193#ifdef NC_DOUBLE
194      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aps)
195#else
196      ierr = NF_GET_VAR_REAL(nid, nvarid, aps)
197#endif
198      IF (ierr .NE. NF_NOERR) THEN
199         PRINT*, "readhead_NC: Lecture echouee pour <aps>"
200         CALL abort
201      ENDIF
202
203      ierr = NF_INQ_VARID (nid, "bps", nvarid)
204      IF (ierr .NE. NF_NOERR) THEN
205         PRINT*, "readhead_NC: Le champ <bps> est absent"
206         CALL abort
207      ENDIF
208#ifdef NC_DOUBLE
209      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bps)
210#else
211      ierr = NF_GET_VAR_REAL(nid, nvarid, bps)
212#endif
213      IF (ierr .NE. NF_NOERR) THEN
214         PRINT*, "readhead_NC: Lecture echouee pour <bps>"
215         CALL abort
216      ENDIF
217
218   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
219     *rrage est differente de la valeur parametree iim =',i4//)
220   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
221     *rrage est differente de la valeur parametree jjm =',i4//)
222   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier demar
223     *rage est differente de la valeur parametree llm =',i4//)
224   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier demar
225     *rage est differente de la valeur  dtinteg =',i4//)
226
227     
228c Fermer le fichier:
229c
230      ierr = NF_CLOSE(nid)
231c
232      RETURN
233      END
Note: See TracBrowser for help on using the repository browser.