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