[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, |
---|
[1977] | 7 | . rad,omeg,g,cpp,kappa,r,pi |
---|
[1422] | 8 | USE temps_mod, ONLY: day_ini |
---|
| 9 | USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 |
---|
| 10 | |
---|
[38] | 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 | |
---|
[1977] | 112 | ierr = NF_INQ_VARID (nid, "longitude", nvarid) |
---|
[38] | 113 | IF (ierr .NE. NF_NOERR) THEN |
---|
[1977] | 114 | PRINT*, "readhead_NC: Le champ <longitude> est absent" |
---|
[38] | 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 |
---|
[1977] | 123 | PRINT*, "readhead_NC: Lecture echouee pour <longitude>" |
---|
[38] | 124 | CALL abort |
---|
| 125 | ENDIF |
---|
[1977] | 126 | ! convert it to radians |
---|
| 127 | rlonu(:)=rlonu(:)*pi/180. |
---|
| 128 | |
---|
| 129 | ierr = NF_INQ_VARID (nid, "latitude", nvarid) |
---|
[38] | 130 | IF (ierr .NE. NF_NOERR) THEN |
---|
[1977] | 131 | PRINT*, "readhead_NC: Le champ <latitude> est absent" |
---|
[38] | 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 |
---|
[1977] | 140 | PRINT*, "readhead_NC: Lecture echouee pour latitude" |
---|
[38] | 141 | CALL abort |
---|
| 142 | ENDIF |
---|
[1977] | 143 | ! convert it to radians |
---|
| 144 | rlatv(:)=rlatv(:)*pi/180. |
---|
[38] | 145 | |
---|
[1977] | 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 |
---|
[38] | 151 | c |
---|
| 152 | c Lecture des aires des mailles: |
---|
| 153 | c |
---|
| 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 |
---|
| 173 | c |
---|
| 174 | c Lecture du geopotentiel au sol: |
---|
| 175 | c |
---|
| 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 |
---|
| 190 | c 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 | |
---|
| 232 | c Fermer le fichier: |
---|
| 233 | c |
---|
| 234 | ierr = NF_CLOSE(nid) |
---|
| 235 | c |
---|
| 236 | RETURN |
---|
| 237 | END |
---|