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 |
---|
8 | USE temps_mod, ONLY: day_ini |
---|
9 | USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 |
---|
10 | |
---|
11 | IMPLICIT none |
---|
12 | c====================================================================== |
---|
13 | c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818 |
---|
14 | c Adaptation à Mars : Yann Wanherdrick |
---|
15 | c Objet: Lecture de l etat initial pour la physique |
---|
16 | c====================================================================== |
---|
17 | #include "netcdf.inc" |
---|
18 | c====== includes de l ancien readhead === |
---|
19 | #include "dimensions.h" |
---|
20 | #include "paramet.h" |
---|
21 | #include "comgeom.h" |
---|
22 | |
---|
23 | c====================================================================== |
---|
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 |
---|
32 | c |
---|
33 | INTEGER i |
---|
34 | |
---|
35 | c Variables |
---|
36 | c |
---|
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 | |
---|
43 | c |
---|
44 | INTEGER day0 |
---|
45 | REAL phis(ip1jmp1),constR |
---|
46 | c |
---|
47 | c Ouvrir le fichier contenant l etat initial: |
---|
48 | c |
---|
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 |
---|
54 | c |
---|
55 | c Lecture des parametres de controle: |
---|
56 | c |
---|
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 | |
---|
73 | c 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) |
---|
81 | c 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) |
---|
91 | c pas vrai pour diagfi, seulement pour start preff = tab_cntrl(18) |
---|
92 | preff=610. |
---|
93 | WRITE (*,*) 'readhead - preff ' , preff |
---|
94 | c |
---|
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 |
---|
147 | c |
---|
148 | c Lecture des aires des mailles: |
---|
149 | c |
---|
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 |
---|
169 | c |
---|
170 | c Lecture du geopotentiel au sol: |
---|
171 | c |
---|
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 |
---|
186 | c 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 | |
---|
228 | c Fermer le fichier: |
---|
229 | c |
---|
230 | ierr = NF_CLOSE(nid) |
---|
231 | c |
---|
232 | RETURN |
---|
233 | END |
---|