SURFEX v8.1
General documentation of Surfex
facade.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 facade_fort &
4 & (fa, cdnomc, ktyptr, pslapo, pclopo, pslopo, &
5 & pcodil, ktronc, knlati, knxlon, knlopa, &
6 & knozpa, psinla, kniver, prefer, pahybr, &
7 & pbhybr, ldgard )
8 USE fa_mod, ONLY : fa_com, jpniil
9 USE parkind1, ONLY : jprb
10 USE yomhook , ONLY : lhook, dr_hook
11 USE lfi_precision
12 IMPLICIT NONE
13 !****
14 ! Sous-programme servant a DEfinir un CADre, voire a le
15 ! redefinir.
16 !**
17 ! Arguments : CDNOMC ==> Nom symbolique du cadre;
18 ! (tous d'Entree) KTYPTR ==> Type de transformation horizontale;
19 ! PSLAPO ==> Sinus de la latitude du pole d'interet;
20 ! PCLOPO ==> Cosinus " " longitude " " " ;
21 ! PSLOPO ==> Sinus " " longitude " " " ;
22 ! PCODIL ==> Coefficient de dilatation;
23 ! KTRONC ==> Troncature;
24 ! KNLATI ==> Nombre de latitudes (de pole a pole);
25 ! KNXLON ==> Nombre maxi de longitudes par parallele;
26 ! (Tableau) KNLOPA ==> Nombre de longitudes par parallele;
27 ! (du pole nord vers l'equateur seulement)
28 ! (Tableau) KNOZPA ==> Nombre d'onde zonal maxi par parallele;
29 ! (du pole nord vers l'equateur seulement)
30 ! (Tableau) PSINLA ==> Sinus des latitudes de l'hemisphere nord
31 ! (du pole nord vers l'equateur seulement)
32 ! KNIVER ==> Nombre de niveaux verticaux;
33 ! PREFER ==> Pression de reference (facteur multipli-
34 ! catif de la premiere fonction de la
35 ! coordonnee hybride)
36 ! (Tableau) PAHYBR ==> Valeurs de la fonction "A" de la coordo-
37 ! nnee hybride AUX LIMITES DE COUCHES;
38 ! (Tableau) PBHYBR ==> Valeurs de la fonction "B" de la coordo-
39 ! nnee hybride AUX LIMITES DE COUCHES;
40 ! LDGARD ==> Vrai si le cadre doit etre conserve meme
41 ! apres la fermeture du dernier fichier
42 ! qui s'y rattache.
43 !*
44 ! La "redefinition" d'un cadre est possible a l'une de ces
45 ! conditions:
46 !
47 ! - le cadre a ete defini, mais n'a aucun fichier qui s'y rattache;
48 ! - le cadre defini a au moins un fichier qui s'y rattache, et les
49 ! nouveaux parametres de definition sont identiques a ceux deja
50 ! definis.
51 !
52 ! Toute "redefinition" de cadre donne lieu a une messagerie
53 ! de niveau 1, donc non masquee par defaut.
54 !
55 !
56 !
57 TYPE(fa_com) :: FA
58 INTEGER (KIND=JPLIKB) KTYPTR, KTRONC, KNLATI, KNXLON, KNIVER
59 !
60 INTEGER (KIND=JPLIKB) KNLOPA (fa%jpxpah), KNOZPA (fa%jpxind)
61 !
62 REAL (KIND=JPDBLR) PSLAPO, PCLOPO, PSLOPO, PCODIL, PREFER
63 !
64 REAL (KIND=JPDBLR) PSINLA ((1+knlati)/2), PAHYBR (0:kniver), PBHYBR (0:kniver)
65 !
66 CHARACTER CDNOMC*(*)
67 !
68 LOGICAL LDGARD
69 !
70 INTEGER (KIND=JPLIKB) IPHASE, IGARDE, IREP, IRANGC
71 INTEGER (KIND=JPLIKB) ILNOMC, INIMES, INUMER
72 !
73 LOGICAL LLREDF, LLMODC
74 !
75 !
76 !
77 CHARACTER(LEN=FA%JPXNOM) CLACTI
78 CHARACTER(LEN=FA%JPLMES) CLMESS
79 CHARACTER(LEN=FA%JPLSPX) CLNSPR
80 LOGICAL LLFATA
81 
82 !**
83 ! 1. - SI PREMIERE UTILISATION, APPEL AU SOUS-PROGRAMME "FARINE".
84 !-----------------------------------------------------------------------
85 !
86 REAL(KIND=JPRB) :: ZHOOK_HANDLE
87 IF (lhook) CALL dr_hook('FACADE_MT',0,zhook_handle)
88 clacti=''
89 IF (fa%FACADE_LLPREA) THEN
90  CALL farine_fort &
91 & (fa, 2_jplikb )
92  fa%FACADE_LLPREA=.false.
93 ENDIF
94 !**
95 ! 2. - LE TRAVAIL EST SOUS-TRAITE AU SOUS-PROGRAMME "FACADI".
96 !-----------------------------------------------------------------------
97 !
98 iphase=0
99 !
100 IF (ldgard) THEN
101  igarde=2
102 ELSE
103  igarde=0
104 ENDIF
105 !
106 ! Verrouillage global prealable, si necessaire.
107 !
108 IF (fa%LFAMUL) CALL lfiver_fort &
109 & (fa%LFI, fa%VRGLAS,'ON')
110 !
111 CALL facadi_fort &
112 & (fa, irep,cdnomc,ktyptr,pslapo,pclopo, &
113 & pslopo,pcodil, &
114 & ktronc,knlati,knxlon,knlopa,knozpa,psinla,kniver, &
115 & prefer,pahybr,pbhybr,llmodc,llredf,iphase,irangc, &
116 & ilnomc,igarde)
117 ilnomc=min(ilnomc,fa%NCPCAD)
118 !**
119 ! 10. - PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
120 ! VIA LE sous-programme "FAIPAR" .
121 !-----------------------------------------------------------------------
122 !
123 !
124 ! Deverrouillage global eventuel.
125 !
126 IF (fa%LFAMUL) CALL lfiver_fort &
127 & (fa%LFI, fa%VRGLAS,'OFF')
128 !
129 llfata=llmoer(irep,0_jplikb )
130 !
131 IF (llfata) THEN
132  inimes=2
133 ELSEIF (fa%NIMSGA.EQ.0) THEN
134  inimes=0
135 ELSEIF (llmodc) THEN
136  inimes=1
137  WRITE (unit=clmess,fmt= &
138 & '(''PARAMETRES NUMERIQUES DU CADRE '''''',A,'''''' MODIFIES '', &
139 & '' - CONSERVATION A LA FERMETURE DU DERNIER FICHIER= '',L1)') &
140 & cdnomc(1:ilnomc),ldgard
141 ELSEIF (llredf) THEN
142  inimes=1
143  WRITE (unit=clmess,fmt='(''CADRE '''''',A, &
144 & '''''' REDEFINI - MEMES PARAMETRES NUMERIQUES - '', &
145 & '' CONSERVATION A LA FERMETURE DU DERNIER FICHIER= '',L1)') &
146 & cdnomc(1:ilnomc),ldgard
147 ELSEIF (fa%NIMSGA.EQ.2) THEN
148  inimes=2
149 ELSE
150  inimes=0
151 ENDIF
152 !
153 IF (inimes.EQ.0) THEN
154  IF (lhook) CALL dr_hook('FACADE_MT',1,zhook_handle)
155  RETURN
156 ENDIF
157 !
158 clnspr='FACADE'
159 inumer=jpniil
160 !
161 IF (inimes.EQ.1.AND.fa%NIMSGA.EQ.2) THEN
162 !
163 ! Cas ou il faut en fait 2 messages.
164 !
165  CALL faipar_fort &
166 & (fa, inumer,inimes,irep,.false.,clmess, &
167 & clnspr,clacti,.false.)
168  inimes=2
169 ENDIF
170 !
171 IF (inimes.EQ.2) THEN
172 !
173  IF (irep.EQ.-65.AND.ilnomc.EQ.1) THEN
174  ilnomc=8
175  clacti(1:ilnomc)=fa%CHAINC(:ilnomc)
176  ELSE
177  ilnomc=min(int(len(clacti), jplikb),ilnomc,fa%NCPCAD)
178  clacti(1:ilnomc)=cdnomc(1:ilnomc)
179  ENDIF
180 !
181  WRITE (unit=clmess, &
182 & fmt='(''ARGUMENTS SIMPLES= '''''',A,'''''','' &
183 & ,I2,4('','',F7.4),3('','',I6),'','',I5,'','',F11.4,'', '',L1)') &
184 & clacti(1:ilnomc),ktyptr,pslapo,pclopo,pslopo,pcodil, &
185 & ktronc,knlati,knxlon,kniver,prefer,ldgard
186 ENDIF
187 !
188 CALL faipar_fort &
189 & (fa, inumer,inimes,irep,llfata,clmess, &
190 & clnspr,clacti(1:ilnomc),.false.)
191 !
192 IF (lhook) CALL dr_hook('FACADE_MT',1,zhook_handle)
193 
194 CONTAINS
195 
196 #include "facom2.llmoer.h"
197 
198 END SUBROUTINE facade_fort
199 
200 
201 
202 ! Oct-2012 P. Marguinaud 64b LFI
203 SUBROUTINE facade64 &
204 & (cdnomc, ktyptr, pslapo, pclopo, pslopo, pcodil, &
205 & ktronc, knlati, knxlon, knlopa, knozpa, psinla, &
206 & kniver, prefer, pahybr, pbhybr, ldgard)
207 USE fa_mod, ONLY : fa => fa_com_default, &
208 & fa_com_default_init, &
209 & new_fa_default
210 USE lfi_precision
211 IMPLICIT NONE
212 ! Arguments
213 CHARACTER (LEN=*) CDNOMC ! IN
214 INTEGER (KIND=JPLIKB) KTYPTR ! IN
215 REAL (KIND=JPDBLR) PSLAPO ! IN
216 REAL (KIND=JPDBLR) PCLOPO ! IN
217 REAL (KIND=JPDBLR) PSLOPO ! IN
218 REAL (KIND=JPDBLR) PCODIL ! IN
219 INTEGER (KIND=JPLIKB) KTRONC ! IN
220 INTEGER (KIND=JPLIKB) KNLATI ! IN
221 INTEGER (KIND=JPLIKB) KNXLON ! IN
222 INTEGER (KIND=JPLIKB) KNLOPA (*) ! IN
223 INTEGER (KIND=JPLIKB) KNOZPA (*) ! IN
224 REAL (KIND=JPDBLR) PSINLA ((1+knlati)/2) ! IN
225 INTEGER (KIND=JPLIKB) KNIVER ! IN
226 REAL (KIND=JPDBLR) PREFER ! IN
227 REAL (KIND=JPDBLR) PAHYBR (0:kniver) ! IN
228 REAL (KIND=JPDBLR) PBHYBR (0:kniver) ! IN
229 LOGICAL LDGARD ! IN
230 
231 IF (.NOT. fa_com_default_init) CALL new_fa_default ()
232 
233 CALL facade_fort &
234 & (fa, cdnomc, ktyptr, pslapo, pclopo, pslopo, pcodil, &
235 & ktronc, knlati, knxlon, knlopa, knozpa, psinla, &
236 & kniver, prefer, pahybr, pbhybr, ldgard)
237 
238 END SUBROUTINE facade64
239 
240 SUBROUTINE facade &
241 & (cdnomc, ktyptr, pslapo, pclopo, pslopo, pcodil, &
242 & ktronc, knlati, knxlon, knlopa, knozpa, psinla, &
243 & kniver, prefer, pahybr, pbhybr, ldgard)
244 USE fa_mod, ONLY : fa => fa_com_default, &
245 & fa_com_default_init, &
246 & new_fa_default
247 USE lfi_precision
248 IMPLICIT NONE
249 ! Arguments
250 CHARACTER (LEN=*) CDNOMC ! IN
251 INTEGER (KIND=JPLIKM) KTYPTR ! IN
252 REAL (KIND=JPDBLR) PSLAPO ! IN
253 REAL (KIND=JPDBLR) PCLOPO ! IN
254 REAL (KIND=JPDBLR) PSLOPO ! IN
255 REAL (KIND=JPDBLR) PCODIL ! IN
256 INTEGER (KIND=JPLIKM) KTRONC ! IN
257 INTEGER (KIND=JPLIKM) KNLATI ! IN
258 INTEGER (KIND=JPLIKM) KNXLON ! IN
259 INTEGER (KIND=JPLIKM) KNLOPA (*) ! IN
260 INTEGER (KIND=JPLIKM) KNOZPA (*) ! IN
261 REAL (KIND=JPDBLR) PSINLA ((1+knlati)/2) ! IN
262 INTEGER (KIND=JPLIKM) KNIVER ! IN
263 REAL (KIND=JPDBLR) PREFER ! IN
264 REAL (KIND=JPDBLR) PAHYBR (0:kniver) ! IN
265 REAL (KIND=JPDBLR) PBHYBR (0:kniver) ! IN
266 LOGICAL LDGARD ! IN
267 
268 IF (.NOT. fa_com_default_init) CALL new_fa_default ()
269 
270 CALL facade_mt &
271 & (fa, cdnomc, ktyptr, pslapo, pclopo, pslopo, pcodil, &
272 & ktronc, knlati, knxlon, knlopa, knozpa, psinla, &
273 & kniver, prefer, pahybr, pbhybr, ldgard)
274 
275 END SUBROUTINE facade
276 
277 SUBROUTINE facade_mt &
278 & (fa, cdnomc, ktyptr, pslapo, pclopo, pslopo, pcodil, &
279 & ktronc, knlati, knxlon, knlopa, knozpa, psinla, &
280 & kniver, prefer, pahybr, pbhybr, ldgard)
281 USE fa_mod, ONLY : fa_com
282 USE lfi_precision
283 IMPLICIT NONE
284 ! Arguments
285 type(fa_com) fa ! INOUT
286 CHARACTER (LEN=*) CDNOMC ! IN
287 INTEGER (KIND=JPLIKM) KTYPTR ! IN
288 REAL (KIND=JPDBLR) PSLAPO ! IN
289 REAL (KIND=JPDBLR) PCLOPO ! IN
290 REAL (KIND=JPDBLR) PSLOPO ! IN
291 REAL (KIND=JPDBLR) PCODIL ! IN
292 INTEGER (KIND=JPLIKM) KTRONC ! IN
293 INTEGER (KIND=JPLIKM) KNLATI ! IN
294 INTEGER (KIND=JPLIKM) KNXLON ! IN
295 INTEGER (KIND=JPLIKM) KNLOPA (fa%jpxpah) ! IN
296 INTEGER (KIND=JPLIKM) KNOZPA (fa%jpxind) ! IN
297 REAL (KIND=JPDBLR) PSINLA ((1+knlati)/2) ! IN
298 INTEGER (KIND=JPLIKM) KNIVER ! IN
299 REAL (KIND=JPDBLR) PREFER ! IN
300 REAL (KIND=JPDBLR) PAHYBR (0:kniver) ! IN
301 REAL (KIND=JPDBLR) PBHYBR (0:kniver) ! IN
302 LOGICAL LDGARD ! IN
303 ! Local integers
304 INTEGER (KIND=JPLIKB) ITYPTR ! IN
305 INTEGER (KIND=JPLIKB) ITRONC ! IN
306 INTEGER (KIND=JPLIKB) INLATI ! IN
307 INTEGER (KIND=JPLIKB) INXLON ! IN
308 INTEGER (KIND=JPLIKB) INLOPA (fa%jpxpah) ! IN
309 INTEGER (KIND=JPLIKB) INOZPA (fa%jpxind) ! IN
310 INTEGER (KIND=JPLIKB) INIVER ! IN
311 ! Ancillary varibles
312 LOGICAL LLMLAM
313 INTEGER (KIND=JPLIKB) ISZNLOPA, ISZNOZPA
314 ! Convert arguments
315 
316 llmlam=ktyptr.LE.0
317 
318 IF (.NOT.llmlam) THEN
319  isznlopa=int((1+knlati)/2, jplikb)
320  isznozpa=int((1+knlati)/2, jplikb)
321 ELSE
322  isznlopa=8
323  isznozpa=0
324 ENDIF
325 
326 ityptr = int( ktyptr, jplikb)
327 itronc = int( ktronc, jplikb)
328 inlati = int( knlati, jplikb)
329 inxlon = int( knxlon, jplikb)
330 iniver = int( kniver, jplikb)
331 
332 inlopa(1:isznlopa) = int(knlopa(1:isznlopa), jplikb)
333 inozpa(1:isznozpa) = int(knozpa(1:isznozpa), jplikb)
334 
335 CALL facade_fort &
336 & (fa, cdnomc, ityptr, pslapo, pclopo, pslopo, pcodil, &
337 & itronc, inlati, inxlon, inlopa, inozpa, psinla, &
338 & iniver, prefer, pahybr, pbhybr, ldgard)
339 
340 
341 END SUBROUTINE facade_mt
342 
343 !INTF CDNOMC IN
344 !INTF KTYPTR IN
345 !INTF PSLAPO IN
346 !INTF PCLOPO IN
347 !INTF PSLOPO IN
348 !INTF PCODIL IN
349 !INTF KTRONC IN
350 !INTF KNLATI IN
351 !INTF KNXLON IN
352 !INTF KNLOPA IN DIMS=FA%JPXPAH
353 !INTF KNOZPA IN DIMS=FA%JPXIND
354 !INTF PSINLA IN DIMS=(1+KNLATI)/2
355 !INTF KNIVER IN
356 !INTF PREFER IN
357 !INTF PAHYBR IN DIMS=0:KNIVER
358 !INTF PBHYBR IN DIMS=0:KNIVER
359 !INTF LDGARD IN
360 
lfi_precision::jplikb
integer, parameter jplikb
Definition: lfi_precision.F90:25
facade64
subroutine facade64(CDNOMC, KTYPTR, PSLAPO, PCLOPO, PSLOPO, PCODIL, KTRONC, KNLATI, KNXLON, KNLOPA, KNOZPA, PSINLA, KNIVER, PREFER, PAHYBR, PBHYBR, LDGARD)
Definition: facade.F90:207
yomhook::dr_hook
Definition: yomhook.F90:20
fa_mod::fa_com_default_init
logical, save fa_com_default_init
Definition: fa_mod.F90:477
facadi_fort
subroutine facadi_fort(FA, KREP, CDNOMC, KTYPTR, PSLAPO, PCLOPO, PSLOPO, PCODIL, KTRONC, KNLATI, KNXLON, KNLOPA, KNOZPA, PSINLA, KNIVER, PREFER, PAHYBR, PBHYBR, LDMODC, LDREDF, KPHASE, KRANGC, KLNOMC, KGARDE)
Definition: facadi.F90:12
fa_mod::new_fa_default
subroutine new_fa_default()
Definition: fa_mod.F90:649
facade
subroutine facade(CDNOMC, KTYPTR, PSLAPO, PCLOPO, PSLOPO, PCODIL, KTRONC, KNLATI, KNXLON, KNLOPA, KNOZPA, PSINLA, KNIVER, PREFER, PAHYBR, PBHYBR, LDGARD)
Definition: facade.F90:244
fa_mod
Definition: fa_mod.F90:1
lfiver_fort
subroutine lfiver_fort(LFI, PVEROU, CDSENS)
Definition: lfiver.F90:6
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:32
facade_mt
subroutine facade_mt(FA, CDNOMC, KTYPTR, PSLAPO, PCLOPO, PSLOPO, PCODIL, KTRONC, KNLATI, KNXLON, KNLOPA, KNOZPA, PSINLA, KNIVER, PREFER, PAHYBR, PBHYBR, LDGARD)
Definition: facade.F90:281
farine_fort
subroutine farine_fort(FA, KOPTIO)
Definition: farine.F90:5
yomhook::lhook
logical lhook
Definition: yomhook.F90:15
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
lfi_precision
Definition: lfi_precision.F90:1
facade_fort
subroutine facade_fort(FA, CDNOMC, KTYPTR, PSLAPO, PCLOPO, PSLOPO, PCODIL, KTRONC, KNLATI, KNXLON, KNLOPA, KNOZPA, PSINLA, KNIVER, PREFER, PAHYBR, PBHYBR, LDGARD)
Definition: facade.F90:8
fa_mod::jpniil
integer(kind=jplikb), parameter jpniil
Definition: fa_mod.F90:31
Generated on Tue Jan 16 2018 16:23:21 for SURFEX v8.1 by   doxygen 1.8.13