SURFEX v8.1
General documentation of Surfex
facilo.F90
Go to the documentation of this file.
1 ! Oct-2012 P. Marguinaud 64b LFI
2 ! Jan-2011 P. Marguinaud Thread-safe FA
3 SUBROUTINE facilo_fort &
4 & (fa, krep, knumer, cdpref, knivau, cdsuff, &
5 & pchamp, ldcosp, ldundf, pundf)
6 USE fa_mod, ONLY : fa_com, fagr1tab
7 USE parkind1, ONLY : jprb
8 USE yomhook , ONLY : lhook, dr_hook
9 USE lfi_precision
10 IMPLICIT NONE
11 !****
12 ! Sous-programme de LECTURE d'un CHAMP HORIZONTAL sur un fichier
13 ! ARPEGE, avec re-arrangement des coefficients spectraux, le cas
14 ! echeant.
15 ! ( Champ d'Interet en LEcture )
16 !**
17 ! Arguments : KREP (Sortie) ==> Code-reponse du sous-programme;
18 ! KNUMER (Entree) ==> Numero de l'unite logique;
19 ! CDPREF (Entree) ==> Prefixe eventuel du nom d'article;
20 ! KNIVAU (Entree) ==> Niveau vertical eventuel;
21 ! CDSUFF (Entree) ==> Suffixe eventuel du nom d'article;
22 ! ( Tableau ) PCHAMP (Sortie) ==> Valeurs REELLES du champ lu;
23 ! rangement modele.
24 ! LDCOSP (Entree) ==> Vrai si le champ est represente
25 ! par des coefficients spectraux.
26 ! LDUNDF (Sortie) ==> Vrai si ce champ a des valeurs
27 ! indefinies
28 ! PUNDF (Sortie) ==> Dans le cas ou LDUNDF est vrai,
29 ! valeur non definie
30 !
31 !
32 TYPE(fa_com) FA
33 INTEGER (KIND=JPLIKB) KREP ! OUT
34 INTEGER (KIND=JPLIKB) KNUMER ! IN
35 CHARACTER (LEN=*) CDPREF ! IN
36 INTEGER (KIND=JPLIKB) KNIVAU ! IN
37 CHARACTER (LEN=*) CDSUFF ! IN
38 REAL (KIND=JPDBLR) PCHAMP (*) ! OUT
39 LOGICAL LDCOSP ! IN
40 LOGICAL, OPTIONAL :: LDUNDF ! OUT
41 REAL (KIND=JPDBLR), OPTIONAL :: PUNDF ! OUT
42 !
43 REAL (KIND=JPDBLR), ALLOCATABLE :: ZCHAMP (:)
44 INTEGER (KIND=JPLIKB) IRANG, IRANGC, INIMES
45 INTEGER (KIND=JPLIKB) ISMAX, IMSMAX
46 INTEGER (KIND=JPLIKB) INGRIB, INBITS, ISTRON, IPUILA
47 INTEGER (KIND=JPLIKB) IREP
48 LOGICAL LLEXIST, LLCOSP, LLREORD
49 CHARACTER(LEN=FA%JPLSPX) CLNSPR
50 CHARACTER(LEN=FA%JPLMES) CLMESS
51 LOGICAL LLRLFI, LLFATA
52 LOGICAL :: LLUNDF
53 REAL (KIND=JPDBLR) :: ZUNDF
54 type(fagr1tab) :: ylgr1tab
55 !**
56 ! 1. - CONTROLES ET INITIALISATIONS.
57 !-----------------------------------------------------------------------
58 !
59 REAL(KIND=JPRB) :: ZHOOK_HANDLE
60 IF (lhook) CALL dr_hook('FACILO_MT',0,zhook_handle)
61 
62 llundf = .false.
63 IF (PRESENT (ldundf )) llundf = ldundf
64 zundf = 0._jpdblr
65 IF (PRESENT (pundf )) zundf = pundf
66 
67 irep = 0
68 llrlfi=.false.
69 
70 CALL fanumu_fort (fa, knumer,irang)
71 
72 IF (irang .EQ. 0) THEN
73  irep = -51
74  GOTO 1001
75 ENDIF
76 
77 CALL fanion_fort (fa, irep, knumer, cdpref, knivau, cdsuff, &
78  & llexist, llcosp, ingrib, inbits, istron, ipuila)
79 
80 IF (irep /= 0) GOTO 1001
81 
82 IF (.NOT. llexist) THEN
83  irep = -89
84  GOTO 1001
85 ENDIF
86 
87 IF (llcosp .NEQV. ldcosp) THEN
88  irep = -92
89  GOTO 1001
90 ENDIF
91 
92 irangc = fa%FICHIER(irang)%NUCADR
93 llreord = llcosp .AND. (.NOT.(ingrib==-1 .OR. ingrib==3 .OR. falgra(ingrib)))
94 
95 IF (llreord) THEN
96  ismax = fa%CADRE(irangc)%NSMAX
97  imsmax = fa%CADRE(irangc)%NMSMAX
98  ALLOCATE (zchamp(4 * (imsmax+1) * (ismax+1))) ! Assez grand
99 
100  CALL facil1_fort (fa, irep, knumer, cdpref, knivau, cdsuff, zchamp, ldcosp, &
101  & llundf, zundf, ylgr1tab)
102  IF (irep /= 0) GOTO 1001
103  CALL fareor_fort (fa, irep, knumer, pchamp, zchamp, .true.)
104  IF (irep /= 0) GOTO 1001
105  DEALLOCATE (zchamp)
106 ELSE
107  CALL facil1_fort (fa, irep, knumer, cdpref, knivau, cdsuff, pchamp, ldcosp, &
108  & llundf, zundf, ylgr1tab)
109 ENDIF
110 
111 1001 CONTINUE
112 krep=irep
113 
114 llfata=llmoer(krep,irang)
115 
116 IF (llfata) THEN
117  inimes=2
118 ELSE
119  inimes=ixnvms(irang)
120 ENDIF
121 
122 IF (PRESENT (ldundf )) ldundf = llundf
123 IF (PRESENT (pundf )) pundf = zundf
124 
125 IF (.NOT.llfata.AND.inimes.NE.2) THEN
126  IF (lhook) CALL dr_hook('FACILO_MT',1,zhook_handle)
127  RETURN
128 ENDIF
129 
130 clnspr='FACILO'
131 
132 WRITE (unit=clmess,fmt='(''KREP='',I5,'', KNUMER='',I3, &
133 & '', CDPREF='''''',A,'''''', KNIVAU='',I6, &
134 & '', CDSUFF='''''',A,'''''', LDCOSP= '',L1)') &
135 & krep,knumer,trim(cdpref),knivau,trim(cdsuff),ldcosp
136 
137 CALL faipar_fort &
138 & (fa, knumer,inimes,krep,llfata,clmess, &
139 & clnspr, '',llrlfi)
140 
141 IF (lhook) CALL dr_hook('FACILO_MT',1,zhook_handle)
142 
143 CONTAINS
144 
145 #include "facom2.llmoer.h"
146 #include "facom2.ixnvms.h"
147 #include "falgra.h"
148 
149 END SUBROUTINE facilo_fort
150 
151 ! Oct-2012 P. Marguinaud 64b LFI
152 SUBROUTINE facilo64 &
153 & (krep, knumer, cdpref, knivau, cdsuff, pchamp, &
154 & ldcosp, ldundf, pundf)
155 USE fa_mod, ONLY : fa => fa_com_default, &
156 & fa_com_default_init, &
157 & new_fa_default
158 USE lfi_precision
159 IMPLICIT NONE
160 ! Arguments
161 INTEGER (KIND=JPLIKB) KREP ! OUT
162 INTEGER (KIND=JPLIKB) KNUMER ! IN
163 CHARACTER (LEN=*) CDPREF ! IN
164 INTEGER (KIND=JPLIKB) KNIVAU ! IN
165 CHARACTER (LEN=*) CDSUFF ! IN
166 REAL (KIND=JPDBLR) PCHAMP (*) ! OUT
167 LOGICAL LDCOSP ! IN
168 LOGICAL, OPTIONAL :: LDUNDF ! OUT
169 REAL (KIND=JPDBLR), OPTIONAL :: PUNDF ! OUT
170 
171 #include "facilo_mt64.h"
172 
173 IF (.NOT. fa_com_default_init) CALL new_fa_default ()
174 
175 CALL facilo_fort &
176 & (fa, krep, knumer, cdpref, knivau, cdsuff, pchamp, &
177 & ldcosp, ldundf, pundf)
178 
179 END SUBROUTINE facilo64
180 
181 SUBROUTINE facilo &
182 & (krep, knumer, cdpref, knivau, cdsuff, pchamp, &
183 & ldcosp, ldundf, pundf)
184 USE fa_mod, ONLY : fa => fa_com_default, &
185 & fa_com_default_init, &
186 & new_fa_default
187 USE lfi_precision
188 IMPLICIT NONE
189 ! Arguments
190 INTEGER (KIND=JPLIKM) KREP ! OUT
191 INTEGER (KIND=JPLIKM) KNUMER ! IN
192 CHARACTER (LEN=*) CDPREF ! IN
193 INTEGER (KIND=JPLIKM) KNIVAU ! IN
194 CHARACTER (LEN=*) CDSUFF ! IN
195 REAL (KIND=JPDBLR) PCHAMP (*) ! OUT
196 LOGICAL LDCOSP ! IN
197 LOGICAL, OPTIONAL :: LDUNDF ! OUT
198 REAL (KIND=JPDBLR), OPTIONAL :: PUNDF ! OUT
199 
200 #include "facilo_mt.h"
201 
202 IF (.NOT. fa_com_default_init) CALL new_fa_default ()
203 
204 CALL facilo_mt &
205 & (fa, krep, knumer, cdpref, knivau, cdsuff, pchamp, &
206 & ldcosp, ldundf, pundf)
207 
208 END SUBROUTINE facilo
209 
210 SUBROUTINE facilo_mt &
211 & (fa, krep, knumer, cdpref, knivau, cdsuff, pchamp, &
212 & ldcosp, ldundf, pundf)
213 USE fa_mod, ONLY : fa_com
214 USE lfi_precision
215 IMPLICIT NONE
216 ! Arguments
217 type(fa_com) fa ! INOUT
218 INTEGER (KIND=JPLIKM) KREP ! OUT
219 INTEGER (KIND=JPLIKM) KNUMER ! IN
220 CHARACTER (LEN=*) CDPREF ! IN
221 INTEGER (KIND=JPLIKM) KNIVAU ! IN
222 CHARACTER (LEN=*) CDSUFF ! IN
223 REAL (KIND=JPDBLR) PCHAMP (*) ! OUT
224 LOGICAL LDCOSP ! IN
225 LOGICAL, OPTIONAL :: LDUNDF ! OUT
226 REAL (KIND=JPDBLR), OPTIONAL :: PUNDF ! OUT
227 
228 #include "facilo_mt64.h"
229 
230 ! Local integers
231 INTEGER (KIND=JPLIKB) IREP ! OUT
232 INTEGER (KIND=JPLIKB) INUMER ! IN
233 INTEGER (KIND=JPLIKB) INIVAU ! IN
234 ! Convert arguments
235 
236 inumer = int( knumer, jplikb)
237 inivau = int( knivau, jplikb)
238 
239 CALL facilo_fort &
240 & (fa, irep, inumer, cdpref, inivau, cdsuff, pchamp, &
241 & ldcosp, ldundf, pundf)
242 
243 krep = int( irep, jplikm)
244 
245 END SUBROUTINE facilo_mt
246 
247 !INTF KREP OUT
248 !INTF KNUMER IN
249 !INTF CDPREF IN
250 !INTF KNIVAU IN
251 !INTF CDSUFF IN
252 !INTF PCHAMP OUT DIMS=*
253 !INTF LDCOSP IN
254 !INTF LDUNDF INOUT
255 !INTF PUNDF INOUT
256 
trim
static const char * trim(const char *name, int *n)
Definition: drhook.c:2383
lfi_precision::jplikb
integer, parameter jplikb
Definition: lfi_precision.F90:25
facilo64
subroutine facilo64(KREP, KNUMER, CDPREF, KNIVAU, CDSUFF, PCHAMP, LDCOSP, LDUNDF, PUNDF)
Definition: facilo.F90:155
yomhook::dr_hook
Definition: yomhook.F90:20
fa_mod::fa_com_default_init
logical, save fa_com_default_init
Definition: fa_mod.F90:477
fa_mod::new_fa_default
subroutine new_fa_default()
Definition: fa_mod.F90:649
facilo_mt
subroutine facilo_mt(FA, KREP, KNUMER, CDPREF, KNIVAU, CDSUFF, PCHAMP, LDCOSP, LDUNDF, PUNDF)
Definition: facilo.F90:213
facilo_fort
subroutine facilo_fort(FA, KREP, KNUMER, CDPREF, KNIVAU, CDSUFF, PCHAMP, LDCOSP, LDUNDF, PUNDF)
Definition: facilo.F90:6
fa_mod::fagr1tab
Definition: fa_mod.F90:241
fa_mod
Definition: fa_mod.F90:1
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:32
yomhook::lhook
logical lhook
Definition: yomhook.F90:15
fareor_fort
subroutine fareor_fort(FA, KREP, KNUMER, PCHAMM, PCHAMF, LDFTOM)
Definition: fareor.F90:5
fanion_fort
subroutine fanion_fort(FA, KREP, KNUMER, CDPREF, KNIVAU, CDSUFF, LDEXIS, LDCOSP, KNGRIB, KNARG1, KNARG2, KNARG3)
Definition: fanion.F90:6
lfi_precision::jplikm
integer, parameter jplikm
Definition: lfi_precision.F90:25
fa_mod::fa_com_default
type(fa_com), target, save fa_com_default
Definition: fa_mod.F90:476
faipar_fort
subroutine faipar_fort(FA, KNUMER, KNIMES, KCODE, LDFATA, CDMESS, CDNSPR, CDACTI, LDRLFI)
Definition: faipar.F90:6
fa_mod::fa_com
Definition: fa_mod.F90:252
facil1_fort
subroutine facil1_fort(FA, KREP, KNUMER, CDPREF, KNIVAU, CDSUFF, PCHAMP, LDCOSP, LDUNDF, PUNDF, YDGR1TAB)
Definition: facil1.F90:6
fanumu_fort
subroutine fanumu_fort(FA, KNUMER, KRANG)
Definition: fanumu.F90:5
lfi_precision
Definition: lfi_precision.F90:1
facilo
subroutine facilo(KREP, KNUMER, CDPREF, KNIVAU, CDSUFF, PCHAMP, LDCOSP, LDUNDF, PUNDF)
Definition: facilo.F90:184
Generated on Tue Jan 16 2018 16:23:21 for SURFEX v8.1 by   doxygen 1.8.13