SURFEX v8.1
General documentation of Surfex
echien.F90
Go to the documentation of this file.
1 SUBROUTINE echien(CDNAMC,KTYPTR,LDMAP,&
2  & KTRONC,KDGL,KNXLON,KNLOPA,PSINLA,&
3  & KFLEV,PREF,PVALH,PVBH,KINF,&
4  & PEPS,KULOUT)
5 
6 !**** *ECHIEN* - CHeck Input ENvironment: LAM case
7 
8 ! Purpose.
9 ! --------
10 ! It controls coherence between defined geometry and ALADIN
11 ! file. In the case of inconsistency it calls ABOR1. This
12 ! routine could be also used in order to simply get full
13 ! information from the cadre.
14 
15 !** Interface.
16 ! ----------
17 ! *CALL* *ECHIEN(...)
18 
19 ! Explicit arguments :
20 ! --------------------
21 ! Input - Output(if KINF = 1):
22 ! ----------------------------
23 
24 ! CDNAMC ... Name of the cadre
25 
26 ! Determination of reference geometry:
27 
28 ! KTYPTR ... Truncation NMSMAX
29 ! LDMAP ... .TRUE. : Map projection calculated by EGGPACK
30 ! ... .FALSE.: Biperiodic experiment file, EGGPACK
31 ! routine not called
32 ! KTRONC ... Truncation NSMAX
33 ! KDGL ... Number of latitudes without poles
34 ! KNXLON ... Max. number of longitudes at a parallel
35 ! KNLOPA ... Limited Area characteristics
36 ! PSINLA ... Horizontal geometry characteristics
37 ! KFLEV ... Number of vertical levels
38 ! PREF ... Reference pressure
39 ! PVALH ... "A" coefficients of vertical system
40 ! PVBH ... "B" coefficients of vertical system
41 
42 ! -----------------------------------------------------------------
43 ! Input :
44 ! -------
45 
46 ! PEPS ... Precision of the tests on real variables
47 ! KINF ... Key:
48 ! -1 ==> Checks for climate file
49 ! and call abort at "warning" mismatch.
50 ! 0 ==> Checks for all files
51 ! and call abort at "warning" mismatch.
52 ! -2 ==> Checks for all files
53 ! and call abort at "fatal" mismatch.
54 ! 1 ==> Simply gives back full information
55 ! KULOUT ... Output file unit
56 ! -----------------------------------------------------------------
57 
58 ! Implicit arguments :
59 ! --------------------
60 ! YOMCST
61 
62 ! Method.
63 ! -------
64 ! See documentation
65 
66 ! Externals.
67 ! ----------
68 ! EGGX_N, some FA.. routines.
69 
70 ! Reference.
71 ! ----------
72 ! ARPEGE/ALADIN Documentation.
73 ! Document 'Control of coherence between namelist and Arpege File'
74 ! by R. El Khatib
75 
76 ! Author.
77 ! -------
78 ! Radmila Bubnova *GMAP/COMPAS - stage MICECO*
79 
80 ! Remark.
81 ! -------
82 !****** This routine is a small christmas gift for our friend
83 !****** Ryad El Khatib **************************************
84 ! (hopefully without too many bugs)
85 
86 ! Modifications.
87 ! --------------
88 ! Original : 91-12-10
89 ! Modification : 92-02-07 R El Khatib
90 ! Modification : 92-06-01 R El Khatib (option KINF=-1)
91 ! Modification : 92-06-21 R Bubnova (LAM: ECHIEN * )
92 ! Modification : 94-07-20 R El Khatib (No test on truncation
93 ! if at least one of the two geometry is fully gridpoint)
94 ! Modification : 96-04-03 R El Khatib (Test on truncation only
95 ! when both geometries are spectral)
96 ! Modification : 97-07-17 R El Khatib (Remove test on NSOTRP since
97 ! all actual four corners are controlled)
98 ! Modification : 97-07-22 R El Khatib (Deep cleanup+KINF=-2/-3)
99 ! Modification : 97-09-17 R El Khatib + J.-F. Estrade (Bugfix on
100 ! arrays dimensionnings)
101 ! Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
102 ! - removal of some obsolete comments about poles.
103 ! Modified 01-04-09 by M. Janousek: New geographic parameters
104 ! Modified 03-02-27 by S. Petitcol: Correct ZLONC for latlon domains
105 ! Modified 12-10-2002 by J. Masek : Bugfix for 2D model (LMAP=.F.).
106 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
107 ! Modification : 17-Nov-2004 JD Gril (Mercator Rotated-Tilted)
108 ! R. El Khatib 27-Sep-2013 Boyd window in frame
109 ! R. El Khatib 01-Sep-2014 Ref point and Center of domain printed in
110 ! radians and degrees for an easier debugging of namelists
111 ! ------------------------------------------------------------------
112 
113 USE parkind1 ,ONLY : jpim ,jprb
114 USE yomhook ,ONLY : lhook, dr_hook
115 
116 USE yomcst_ifsaux , ONLY : xrpi , xra
117 
118 IMPLICIT NONE
119 
120 ! ------------------------------------------------------------------
121 
122 INTEGER(KIND=JPIM), PARAMETER :: JPXGEO=18
123 INTEGER(KIND=JPIM), PARAMETER :: JPXPAH=8
124 
125 ! ------------------------------------------------------------------
126 
127 INTEGER(KIND=JPIM),INTENT(INOUT) :: KFLEV
128 CHARACTER(LEN=16),INTENT(IN) :: CDNAMC
129 INTEGER(KIND=JPIM),INTENT(INOUT) :: KTYPTR
130 LOGICAL ,INTENT(INOUT) :: LDMAP
131 INTEGER(KIND=JPIM),INTENT(INOUT) :: KTRONC
132 INTEGER(KIND=JPIM),INTENT(INOUT) :: KDGL
133 INTEGER(KIND=JPIM),INTENT(INOUT) :: KNXLON
134 INTEGER(KIND=JPIM),INTENT(INOUT) :: KNLOPA(jpxpah)
135 REAL(KIND=JPRB) ,INTENT(INOUT) :: PSINLA(jpxgeo)
136 REAL(KIND=JPRB) ,INTENT(INOUT) :: PREF
137 REAL(KIND=JPRB) ,INTENT(INOUT) :: PVALH(0:kflev)
138 REAL(KIND=JPRB) ,INTENT(INOUT) :: PVBH(0:kflev)
139 INTEGER(KIND=JPIM),INTENT(IN) :: KINF
140 REAL(KIND=JPRB) ,INTENT(IN) :: PEPS
141 INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT
142 
143 ! ------------------------------------------------------------------
144 
145 INTEGER(KIND=JPIM), ALLOCATABLE :: INLOPA(:),INOZPA(:)
146 REAL(KIND=JPRB), ALLOCATABLE :: ZVALH(:),ZVBH(:)
147 REAL(KIND=JPRB), ALLOCATABLE :: ZSINLA(:)
148 
149 ! Work files for EGGX only
150 REAL(KIND=JPRB), ALLOCATABLE :: ZGELAM(:,:), ZGELAT(:,:), ZGM(:,:),&
151  & ZGENORX(:,:),ZGENORY(:,:)
152 
153 INTEGER(KIND=JPIM) :: IERR, IERRA, II, INIVER, INLATI, INXLON, ITRONC, &
154  & ITYPTR, JFLEV, JL, JLEV, IROTEQ, ISOTRP, IGIVO, IMAXLEV, IMAXGL, &
155  & IMAXLON, IMAXTRUNC , IBWX, IBWY
156 
157 LOGICAL :: LLMAP, LLGARD
158 
159 REAL(KIND=JPRB) :: Z2PI, ZCLOPO, ZCODIL, ZDIFF, ZREF, ZSLAPO, ZSLOPO, ZEPS
160 REAL(KIND=JPRB) :: ZRPK, ZLON0, ZLAT0, ZLONC, ZLATC, ZDELX, ZDELY, ZELX, ZELY
161 REAL(KIND=JPRB) :: ZEXWN,ZEYWN, ZLON1, ZLAT1, ZLON2, ZLAT2
162 REAL(KIND=JPRB) :: ZHOOK_HANDLE
163 
164 ! ------------------------------------------------------------------
165 
166 #include "eggx_n.h"
167 
168 #include "abor1.intfb.h"
169 
170 ! ------------------------------------------------------------------
171 
172 IF (lhook) CALL dr_hook('ECHIEN',0,zhook_handle)
173 
174 ! ------------------------------------------------------------------
175 
176 !* 0. Get software limits
177 ! -------------------
178 
179 CALL falimu(imaxlev,imaxtrunc,imaxgl,imaxlon)
180 ALLOCATE(inlopa(imaxgl))
181 ALLOCATE(inozpa(imaxgl))
182 ALLOCATE(zsinla(imaxgl))
183 ALLOCATE(zvalh(0:imaxlev))
184 ALLOCATE(zvbh(0:imaxlev))
185 
186 !* 1. Read file characteristics
187 ! -------------------------
188 
189 WRITE(kulout,*) ' HAF, HAF : CADRE : ',cdnamc
190 llgard=.false.
191 CALL facies(cdnamc,ityptr,zslapo,zclopo,zslopo,zcodil,itronc,&
192  & inlati,inxlon,inlopa,inozpa,zsinla,iniver,zref,zvalh,&
193  & zvbh,llgard)
194 
195 IF (kinf == 1) THEN
196  IF (iniver > kflev) THEN
197  CALL abor1('ECHIEN : MAX. NUMBER OF LEVEL IN MODEL TOO SMALL !')
198  ENDIF
199 ENDIF
200 
201 ! ------------------------------------------------------------------
202 
203 !* 2. Preliminary test
204 ! ----------------
205 
206 IF(ityptr > 0) THEN
207  WRITE(kulout,*) 'YOU ARE USING A FILE ARPEGE ',&
208  & 'WHILE THE MODEL EXPECTS A FILE ALADIN'
209  CALL abor1('ECHIEN: ABOR1 CALLED 2')
210 ELSE
211  ityptr = - ityptr
212  llmap=zcodil >= 0.0_jprb
213 ENDIF
214 
215 z2pi = 2.0_jprb*xrpi
216 
217 IF(zsinla(1) >= 0.0_jprb) THEN
218  ! Echien smells the old EGGX (i.e. the old format of the cadre)
219  WRITE(kulout,*) ' the cadre >>',cdnamc,'<< has the old EGGX format'
220  WRITE(kulout,*) ' => consistency check of the geometry in the cadre&
221  & will be more forgiving'
222 
223  zeps=peps*1000._jprb
224 
225  zrpk=zsinla(10)
226  zlon0=zsinla(8)
227  zlat0=zsinla(9)
228  zlon1=zsinla(4)
229  zlat1=zsinla(5)
230  zlon2=zsinla(6)
231  zlat2=zsinla(7)
232  zelx=zsinla(13)
233  zely=zsinla(14)
234  zdelx=zsinla(15)
235  zdely=zsinla(16)
236  zexwn=zsinla(17)
237  zeywn=zsinla(18)
238  zlonc=zsinla(2)
239  zlatc=zsinla(3)
240 
241  IF (zrpk < 0.0_jprb) THEN
242  ! latlon case :
243  IF (zlon1 <= zlon2) THEN
244  zlonc=mod(0.5_jprb*(zlon1+zlon2),z2pi)
245  ELSE
246  zlonc=mod(0.5_jprb*(zlon1-z2pi+zlon2),z2pi)
247  ENDIF
248  zlatc=0.5_jprb*(zlat1+zlat2)
249  zdelx=zsinla(15)
250  zdely=zsinla(16)
251  ELSEIF(llmap) THEN
252  ! projection
253  ALLOCATE(zgelam(inlopa(3):inlopa(4),inlopa(5):inlopa(6)))
254  ALLOCATE(zgelat(inlopa(3):inlopa(4),inlopa(5):inlopa(6)))
255  ALLOCATE(zgm(inlopa(3):inlopa(4),inlopa(5):inlopa(6)))
256  ALLOCATE(zgenorx(inlopa(3):inlopa(4),inlopa(5):inlopa(6)))
257  ALLOCATE(zgenory(inlopa(3):inlopa(4),inlopa(5):inlopa(6)))
258  iroteq=int(zsinla(1))
259  isotrp=int(zsinla(11))
260  igivo=int(zsinla(12))
261 
262  WRITE(kulout,*) 'Call EGGX_N by ECHIEN'
263 
264  CALL eggx_n(xrpi,xra,iroteq,zsinla(2),zsinla(3),zslapo,&
265  & zsinla(4),zsinla(5),zsinla(6),zsinla(7),zlon0,zlat0,&
266  & zsinla(10),kulout,isotrp,igivo,&
267  & zgelam,zgelat,zgm,zgenorx,zgenory,&
268  & inlopa(3),inlopa(4),inlopa(5),inlopa(6),&
269  & inlopa(3),inlopa(4),inlopa(5),inlopa(6),&
270  & zdelx,zdely,zlonc,zlatc)
271  DEALLOCATE(zgelam)
272  DEALLOCATE(zgelat)
273  DEALLOCATE(zgm)
274  DEALLOCATE(zgenorx)
275  DEALLOCATE(zgenory)
276  zsinla(1)=REAL(iroteq,jprb)
277  zsinla(11)=REAL(isotrp,jprb)
278  zsinla(12)=REAL(igivo,jprb)
279  ENDIF
280 
281 ELSE
282 
283  zeps=peps
284 
285  zrpk =zsinla(2)
286  zlon0=zsinla(3)
287  zlat0=zsinla(4)
288  zlonc=zsinla(5)
289  zlatc=zsinla(6)
290  zdelx=zsinla(7)
291  zdely=zsinla(8)
292  zelx =zsinla(9)
293  zely =zsinla(10)
294  zexwn=zsinla(11)
295  zeywn=zsinla(12)
296  zlon1=zsinla(13)
297  zlat1=zsinla(14)
298  zlon2=zsinla(15)
299  zlat2=zsinla(16)
300  ibwx=int(zsinla(17))
301  ibwy=int(zsinla(18))
302 
303 ENDIF
304 
305 IF((kinf == 0).OR.(kinf == -1).OR.(kinf == -2).OR.(kinf == -3)) THEN
306 
307 !* 3. Checklist
308 ! ---------
309 
310  ierr=0
311 
312 !* 3.1 Spectral dimensions
313 
314  IF(inlopa(2) == 1.AND.knlopa(2) == 1) THEN
315  IF(itronc /= ktronc) THEN
316  WRITE(kulout,*) ' TRUNCATION NSMAX MISMATCH : '&
317  & ,'FILE = ',itronc, ' ; ARGUMENT = ',ktronc
318  ierr=1
319  ENDIF
320  IF(ityptr /= ktyptr) THEN
321  WRITE(kulout,*) ' TRUNCATION NMSMAX MISMATCH : '&
322  & ,'FILE = ',ityptr, ' ; ARGUMENT = ',ktyptr
323  ierr=1
324  ENDIF
325  ENDIF
326  IF ((inlopa(2) /= 0.AND.knlopa(2) /= 0).OR.&
327  & (.NOT.llmap.AND..NOT.ldmap)) THEN
328  IF(inxlon /= knxlon) THEN
329  WRITE(kulout,*) ' NUMBER OF LONGITUDES MISMATCH : '&
330  & ,'FILE = ',inxlon, ' ; ARGUMENT = ',knxlon
331  ierr=1
332  ENDIF
333  IF(inlati /= kdgl) THEN
334  WRITE(kulout,*) ' NUMBER OF LATITUDES MISMATCH : '&
335  & ,'FILE = ',inlati, ' ; ARGUMENT = ',kdgl
336  ierr=1
337  ENDIF
338  ENDIF
339 
340 !* 3.3 Horizontal geometry
341 
342  IF((ldmap.AND..NOT.llmap).OR.(llmap.AND..NOT.ldmap)) THEN
343 
344  WRITE(kulout,*) ' HORIZONTAL REPRESENTATION LMAP MISMATCH : '&
345  & ,'FILE = ',llmap, ' ; ARGUMENT = ',ldmap
346  ierr=1
347 
348  ELSEIF(llmap.AND.ldmap) THEN
349 
350  IF((zrpk >= 0.0_jprb .AND. psinla(2) < 0.0_jprb) .OR.&
351  & (zrpk < 0.0_jprb .AND. psinla(2) >= 0.0_jprb)) THEN
352  WRITE(kulout,*) ' PROJECTION TYPE MISMATCH : '&
353  & ,'FILE = ',zrpk, ' ; ARGUMENT = ',psinla(2)
354  ierr=1
355  ENDIF
356 
357  zdiff=abs(mod(zlon0-psinla(3),z2pi))
358  IF(zdiff > zeps.AND.(z2pi-zdiff) > zeps) THEN
359  WRITE(kulout,*) ' REFERENCE LONGITUDE MISMATCH : '&
360  & ,'FILE = ',zlon0,' (',zlon0*180._jprb/xrpi,' DEGREES)', &
361  & ' ; ARGUMENT = ',psinla(3),' (',psinla(3)*180._jprb/xrpi,' DEGREES)'
362  ierr=1
363  ENDIF
364 
365  IF(abs(zlat0-psinla(4)) > zeps) THEN
366  WRITE(kulout,*) ' REFERENCE LATITUDE MISMATCH : '&
367  & ,'FILE = ',zlat0,' (',zlat0*180._jprb/xrpi,' DEGREES)', &
368  & ' ; ARGUMENT = ',psinla(4),' (',psinla(4)*180._jprb/xrpi,' DEGREES)'
369  ierr=1
370  ENDIF
371 
372  zdiff=abs(mod(zlonc-psinla(5),z2pi))
373  IF(zdiff > zeps.AND.(z2pi-zdiff) > zeps) THEN
374  WRITE(kulout,*) ' DOMAIN CENTRE LONGITUDE MISMATCH : '&
375  & ,'FILE = ',zlonc,' (',zlonc*180._jprb/xrpi,' DEGREES)', &
376  & ' ; ARGUMENT = ',psinla(5),' (',psinla(5)*180._jprb/xrpi,' DEGREES)'
377  ierr=1
378  ENDIF
379 
380  IF(abs(zlatc-psinla(6)) > zeps) THEN
381  WRITE(kulout,*) ' DOMAIN CENTRE LATITUDE MISMATCH : '&
382  & ,'FILE = ',zlatc,' (',zlatc*180._jprb/xrpi,' DEGREES)', &
383  & ' ; ARGUMENT = ',psinla(6),' (',psinla(6)*180._jprb/xrpi,' DEGREES)'
384  ierr=1
385  ENDIF
386 
387  IF(abs(zdelx-psinla(7)) > zeps*10000.) THEN
388  WRITE(kulout,*) ' RESOLUTION IN X MISMATCH : '&
389  & ,'FILE = ',zdelx, ' ; ARGUMENT = ',psinla(7)
390  ierr=1
391  ENDIF
392 
393  IF(abs(zdely-psinla(8)) > zeps*10000.) THEN
394  WRITE(kulout,*) ' RESOLUTION IN Y MISMATCH : '&
395  & ,'FILE = ',zdely, ' ; ARGUMENT = ',psinla(8)
396  ierr=1
397  ENDIF
398 
399  IF(inlopa(2) == 0) THEN
400  IF(knlopa(2) /= 0) THEN
401  ! Abort when extension zone in argument is NOT null
402  IF ((knlopa(4)-knlopa(3)+1 /= knxlon).OR.&
403  & (knlopa(6)-knlopa(5)+1 /= kdgl)) THEN
404  IF(kinf == 0.OR.kinf == -1) THEN
405  WRITE(kulout,*) 'HORIZONTAL DOMAIN INDICATOR (NDOM) ',&
406  & 'MISMATCH : ',&
407  & 'FILE = ',inlopa(2), ' (C+I) ; ARGUMENT = ',knlopa(2),&
408  & ' (C+I+E)'
409  WRITE(kulout,*) ' PROPER INITIALIZATION OF (E) '&
410  & ,'IS EXPECTED IN THE CALLING SUBROUTINE'
411  IF(kinf == 0) THEN
412  ii=-2
413  ELSE
414  ii=-3
415  ENDIF
416  WRITE(kulout,*) ' WHEN THIS IS OK, SET KINF=',ii,&
417  & ' IN THE CALLING SUBROUTINE TO ANIHILATE THIS ABORT'
418  ierr=1
419  ENDIF
420  ENDIF
421  ENDIF
422  ELSE
423  IF(knlopa(2) == 0) THEN
424  ! Warning when extension zone in file is NOT null
425  IF ((inlopa(4)-inlopa(3)+1 /= inxlon).OR.&
426  & (inlopa(6)-inlopa(5)+1 /= inlati)) THEN
427  IF(kinf == 0.OR.kinf == -1) THEN
428  WRITE(kulout,*) 'HORIZONTAL DOMAIN INDICATOR (NDOM) ',&
429  & 'MISMATCH : ',&
430  & 'FILE = ',inlopa(2), ' (C+I+E) ; ARGUMENT = ',&
431  & knlopa(2),' (C+I)'
432  WRITE(kulout,*) ' PROPER INITIALIZATION OF (E) '&
433  & ,'IS EXPECTED IN THE CALLING SUBROUTINE'
434  IF(kinf == 0) THEN
435  ii=-2
436  ELSE
437  ii=-3
438  ENDIF
439  WRITE(kulout,*) ' WHEN THIS IS OK, SET KINF=',ii,&
440  & ' IN THE CALLING SUBROUTINE TO ANIHILATE THIS ABORT'
441  ierr=1
442  ENDIF
443  ENDIF
444  ELSEIF(inlopa(2) == 1.AND.knlopa(2) == -1) THEN
445  WRITE(kulout,*) ' CAUTION : FILE CONTAINS SPECTRALLY ','FITTED DATA'
446  ELSEIF(inlopa(2) == -1.AND.knlopa(2) == 1) THEN
447  WRITE(kulout,*) ' CAUTION : FILE CONTAINS UNFITTED DATA'
448  ENDIF
449  ENDIF
450 
451  IF(inlopa(3) /= knlopa(3)) THEN
452  WRITE(kulout,*) ' START INDEX FOR C+I IN X DIRECTION '&
453  & ,'(NDLUNG) MISMATCH : '&
454  & ,' FILE = ',inlopa(3), ' ; ARGUMENT = ',knlopa(3)
455  ierr=1
456  ENDIF
457 
458  IF(inlopa(4) /= knlopa(4)) THEN
459  WRITE(kulout,*) ' END INDEX FOR C+I IN X DIRECTION '&
460  & ,'(NDLUXG) MISMATCH : '&
461  & ,' FILE = ',inlopa(4), ' ; ARGUMENT = ',knlopa(4)
462  ierr=1
463  ENDIF
464 
465  IF(inlopa(5) /= knlopa(5)) THEN
466  WRITE(kulout,*) ' START INDEX FOR C+I IN Y DIRECTION '&
467  & ,'(NDGUNG) MISMATCH : '&
468  & ,' FILE = ',inlopa(5), ' ; ARGUMENT = ',knlopa(5)
469  ierr=1
470  ENDIF
471 
472  IF(inlopa(6) /= knlopa(6)) THEN
473  WRITE(kulout,*) ' END INDEX FOR C+I IN Y DIRECTION '&
474  & ,'(NDGUXG) MISMATCH : '&
475  & ,' FILE = ',inlopa(6), ' ; ARGUMENT = ',knlopa(6)
476  ierr=1
477  ENDIF
478 
479  IF(inlopa(7) /= knlopa(7)) THEN
480  WRITE(kulout,*) 'CAUTION : LENGTH OF I ZONE IN X DIRECTION '&
481  & ,'(NBZONL) MISMATCH : '&
482  & ,' FILE = ',inlopa(7), ' ; ARGUMENT = ',knlopa(7)
483  ENDIF
484 
485  IF(inlopa(8) /= knlopa(8)) THEN
486  WRITE(kulout,*) 'CAUTION : LENGTH OF I ZONE IN Y DIRECTION '&
487  & ,'(NBZONG) MISMATCH : '&
488  & ,' FILE = ',inlopa(8), ' ; ARGUMENT = ',knlopa(8)
489  ENDIF
490 
491  IF (kinf == 0 .AND. zsinla(1) < 0.0_jprb) THEN
492  IF(ibwx < int(psinla(17))) THEN
493  WRITE(kulout,*) ' PORTION OF SCIENTIFIC E-ZONE LYING INSIDE C+I (X AXIS) TOO BIG : '&
494  & ,' FILE = ',ibwx, ' ; ARGUMENT = ',REAL(PSINLA(17),KIND=jprb)
495  ierr=1
496  ENDIF
497  IF(ibwy < int(psinla(18))) THEN
498  WRITE(kulout,*) ' PORTION OF SCIENTIFIC E-ZONE LYING INSIDE C+I (Y AXIS) TOO BIG : '&
499  & ,' FILE = ',ibwy, ' ; ARGUMENT = ',REAL(PSINLA(18),KIND=jprb)
500  ierr=1
501  ENDIF
502  ENDIF
503 
504  ELSE
505 
506  IF(abs(zelx-psinla(9)) > zeps) THEN
507  WRITE(kulout,*) ' WAVE LENGTH IN X DIRECTION MISMATCH : '&
508  & ,'FILE = ',zelx, ' ; ARGUMENT = ',psinla(9)
509  ierr=1
510  ENDIF
511 
512  IF(abs(zely-psinla(10)) > zeps) THEN
513  WRITE(kulout,*) ' WAVE LENGTH IN Y DIRECTION MISMATCH : '&
514  & ,'FILE = ',zely, ' ; ARGUMENT = ',psinla(10)
515  ierr=1
516  ENDIF
517 
518  ENDIF
519 
520 !* 3.4 Vertical levels
521 
522  IF (kinf == 0.OR.kinf == -2) THEN
523  IF(iniver /= kflev) THEN
524  WRITE(kulout,*) ' NUMBER OF LEVELS MISMATCH : '&
525  & ,'FILE = ',iniver, ' ; ARGUMENT = ',kflev
526  ierr=1
527  ELSE
528  ierra=0
529  DO jflev = 0,kflev
530  IF(abs(zvalh(jflev)*zref-pvalh(jflev)*pref) > peps) THEN
531  WRITE(kulout,*) ' VERTICAL FUNCTION *A* MISMATCH ON ',&
532  & 'LEVEL ',jflev,' : ',&
533  & 'FILE = ',zvalh(jflev), ' ; ARGUMENT = ',pvalh(jflev)
534  ierra=1
535  ierr=1
536  ENDIF
537  IF(abs(zvbh(jflev)-pvbh(jflev)) > peps) THEN
538  WRITE(kulout,*) ' VERTICAL FUNCTION *B* MISMATCH ON ',&
539  & 'LEVEL ',jflev,' : ',&
540  & 'FILE = ',zvbh(jflev), ' ; ARGUMENT = ',pvbh(jflev)
541  ierr=1
542  ENDIF
543  ENDDO
544  IF (ierra /= 0) THEN
545  WRITE(kulout,*) ' REFERENCE PRESSURE : ',&
546  & 'FILE = ',zref, ' ; ARGUMENT = ',pref
547  ENDIF
548  ENDIF
549  ENDIF
550 
551 !* 3.5 Packing characteristics (fatal ???)
552 
553  IF(inlopa(1) /= knlopa(1) .AND. (llmap .OR. ldmap) ) THEN
554  WRITE(kulout,*) ' PACKING PARAMETER MISMATCH : '&
555  & ,'FILE = ',inlopa(1), ' ; ARGUMENT = ',knlopa(1)
556  ierr=1
557  ENDIF
558 
559  IF(ierr /= 0) THEN
560  CALL abor1('ECHIEN: ABOR1 CALLED 3.5')
561  ENDIF
562 
563 ! ------------------------------------------------------------------
564 
565 !* 4. Bring back information on file
566 ! ------------------------------
567 
568 ELSEIF(kinf == 1) THEN
569 
570 !* 4.1 Truncation, number of levels, ref. pressure, coef. A, B
571 
572  ktyptr = ityptr
573  ldmap = zcodil >= 0.0_jprb
574  ktronc = itronc
575  kflev = iniver
576  pref = zref
577  DO jlev = 0,kflev
578  pvalh(jlev) = zvalh(jlev)
579  pvbh(jlev) = zvbh(jlev)
580  ENDDO
581 
582 !* 4.2 Geometrical characteristics
583 
584  knxlon = inxlon
585  kdgl = inlati
586  IF (zsinla(1) >= 0.0_jprb) THEN
587  psinla(1) = -1.0_jprb
588  ELSE
589  psinla(1) = zsinla(1)
590  psinla(17)= zsinla(17)
591  psinla(18)= zsinla(18)
592  ENDIF
593  psinla(2) = zrpk
594  psinla(3) = zlon0
595  psinla(4) = zlat0
596  psinla(5) = zlonc
597  psinla(6) = zlatc
598  psinla(7) = zdelx
599  psinla(8) = zdely
600  psinla(9) = zelx
601  psinla(10)= zely
602  psinla(11)= zexwn
603  psinla(12)= zeywn
604  psinla(13)= zlon1
605  psinla(14)= zlat1
606  psinla(15)= zlon2
607  psinla(16)= zlat2
608  DO jl= 1, jpxpah
609  knlopa(jl) = inlopa(jl)
610  ENDDO
611 
612 ELSE
613  WRITE(kulout,*) 'INTERNAL ERROR : KINF = ',kinf
614  CALL abor1('ECHIEN: ABOR1 CALLED 4.2')
615 ENDIF
616 
617 DEALLOCATE(inlopa)
618 DEALLOCATE(inozpa)
619 DEALLOCATE(zsinla)
620 DEALLOCATE(zvalh)
621 DEALLOCATE(zvbh)
622 
623 ! ------------------------------------------------------------------
624 
625 IF (lhook) CALL dr_hook('ECHIEN',1,zhook_handle)
626 END SUBROUTINE echien
yomcst_ifsaux::xrpi
real(kind=jprb) xrpi
Definition: yomcst_ifsaux.F90:15
parkind1::jpim
integer, parameter jpim
Definition: parkind1.F90:13
abor1
subroutine abor1(CDTEXT)
Definition: abor1.F90:2
falimu
subroutine falimu(KXNIVV, KXTRON, KXLATI, KXLONG)
Definition: falimu.F90:115
yomhook::dr_hook
Definition: yomhook.F90:20
yomcst_ifsaux::xra
real(kind=jprb) xra
Definition: yomcst_ifsaux.F90:19
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:32
echien
subroutine echien(CDNAMC, KTYPTR, LDMAP, KTRONC, KDGL, KNXLON, KNLOPA, PSINLA, KFLEV, PREF, PVALH, PVBH, KINF, PEPS, KULOUT)
Definition: echien.F90:5
yomhook::lhook
logical lhook
Definition: yomhook.F90:15
facies
subroutine facies(CDNOMC, KTYPTR, PSLAPO, PCLOPO, PSLOPO, PCODIL, KTRONC, KNLATI, KNXLON, KNLOPA, KNOZPA, PSINLA, KNIVER, PREFER, PAHYBR, PBHYBR, LDGARD)
Definition: facies.F90:276
yomcst_ifsaux
Definition: yomcst_ifsaux.F90:1
eggx_n
subroutine eggx_n(PI, PRA, KROTEQ, PLONR, PLATR, PBETA, PLON1, PLAT1, PLON2, PLAT2, PLON0, PLAT0, PRPK, KULOUT, KSOTRP, KGIVO, PGELAM, PGELAT, PGM, PGNORX, PGNORY, KDLSA, KDLSUR, KDGSA, KDGEN, KDLUN, KDLUX, KDGUN, KDGUX, PDELX, PDELY, PLONC, PLATC)
Definition: eggx_n.F90:6
Generated on Tue Jan 16 2018 16:23:22 for SURFEX v8.1 by   doxygen 1.8.13