Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / bcgrd_fordiachro.f90
1 !     ######spl
2       SUBROUTINE BCGRD_FORDIACHRO(K)
3 !     ##############################
4 !
5 !!****  *BCGRD* - Displays a cartographic background in horizontal mode
6 !!
7 !!    PURPOSE
8 !!    -------
9 !       Displays a cartographic background for horizontal cross-section
10 !     contour or arrow maps when the cartographic projection option is 
11 !     active.  
12 !       The geographical display window is defined, a grid of latitude-
13 !     longitude lines, a set of continental/state outlines and, optionaly,
14 !     a series of landmarks, are plotted on this background. 
15 !
16 !!**  METHOD
17 !!    ------
18 !!     
19 !!     The conformal projection routines of MODE_GRIDPROJ are used to
20 !!    compute the latitude-longitude coordinates of the display box.
21 !!    Next, the NCAR Ezmap projection parameters are set up to 
22 !!    correspond to the Meso-NH projection, and a grid of latitude-
23 !     longitude lines, a set of continental/state outlines and, optionaly,
24 !     a series of landmarks, are plotted as an overlay on the current map.
25 !!
26 !!    EXTERNAL
27 !!    --------
28 !!
29 !!      MAPSTI ! set an NCAR parameter to a valuei, type  INTEGER   !
30 !!      MAPSTC ! (cartographic projection package)        CHARACTER !
31 !!      MAPROJ   selects a type cartographic projection             !
32 !!      MAPDRW   draws a map as specified by the user parameter     !
33 !!               choice                                             !
34 !!      MAPIT    draws a polyline on a map, using map coordinates   ! NCAR
35 !!      MAPIQ    terminates a line drawn by MAPIT                   !
36 !!      MAPSET   defines the plot window using map coordinates      !
37 !!      MAPTRN   projects a point onto a geographic map using       !
38 !!               latitude-longitude to locate the point             !
39 !!                                                                  !
40 !!      PWRITX   prints a text                                      !
41 !!      LABMOD   defines the axes label formats (paired with PERIM) !Routines 
42 !!      GRIDAL   draws grid lines and labels                        !
43 !!      PERIM    draws an unlabeled plot perimeter                  !
44 !!      SET      defines the plot window and viewport using user    !
45 !!               and normalized NCAR coordinates                    !
46 !!      GETSET   retrieves the NCAR and user coordinate definitions !
47 !!      PLCHHQ   high quality printing facility                     !
48 !!      GSCLIP   clips the plot using the window limits             !
49 !!
50 !!    IMPLICIT ARGUMENTS
51 !!    ------------------
52 !!      Module MODD_NMGRID  : declares global variable  NMGRID
53 !!         NMGRID      : Current MESO-NH grid indicator
54 !!
55 !!      Module MODE_GRIDPROJ:  packages a set of cartographic
56 !!                             module-procedures
57 !!         SM_LATLON   : to compute geographic  from conformal (cartographic)
58 !!                       cartesian coordinates;
59 !!         SM_XYHAT    : to compute conformal (cartographic) cartesian from
60 !!                       geographic coordinates;
61 !!         LATREF2     : to compute the second reference latitude
62 !!                       in the case of Lambert conformal projection
63 !!
64 !!      Module MODD_COORD      : declares gridpoint coordinates (TRACE use)
65 !!         XXX,XXY     : coordinate values FOR ALL  the MESO-NH grids
66 !!
67 !!      Module MODD_GRID1      : declares grid variables (Model module)
68 !!         XXHAT, XYHAT  : x, y cartographic coordinates of the model grid
69 !!         XLONOR,XLATOR : longitude and latitude of the (1,1,1) point of
70 !!                         the model mass grid
71 !!
72 !!      Module MODD_GRID    : declaration of grid variables for all models
73 !!         XLON0,XLAT0 : reference longitude and latitude for the conformal
74 !!                       projection
75 !!         XBETA,XRPK  : rotation angle and projection parameter for the 
76 !!                       conformal projection
77 !!      Module MODN_NCAR : defines NAM_DIRTRA_POS namelist
78 !!                         (former NCAR common)
79 !!         NIFDC   : Coastline data style (0 none, 1 NCAR, 2 IGN)
80 !!         NLPCAR  : Number of land-mark points to be plotted
81 !!         XLONCAR :  Longitude of land-mark points
82 !!         XLATCAR :  Latitude  of land-mark points
83 !!
84 !!      Module MODN_PARA  : Defines NAM_DOMAIN_POS namelist (former PARA common)
85 !!       Module MODD_DIM1 : contains dimensions of data arrays
86 !!         NIINF, NISUP : lower and upper bounds of arrays
87 !!                        to be plotted in x direction
88 !!         NJINF, NJSUP : lower and upper bounds of arrays
89 !!                        to be plotted in y direction
90 !!
91 !!    REFERENCE
92 !!    ---------
93 !!
94 !!      MESO-NH User's Manual, TRACE Post Processing sections, Version 1.0:
95 !!       + Book1: Concepts and Fundamentals, to appear in 1994;
96 !!       + Book2: Technical Reference and Flowcharts, to appear in 1994;
97 !!       + Book3: Tutorial, November 1994.
98 !!
99 !!     NCAR Graphics Technical documentation, UNIX version 3.2,
100 !!     Scientific computing division, NCAR/UCAR, Boulder, USA.
101 !!      Volume 1: Fundamentals, Vers. 1, May 1993
102 !!      Volume 2: Contouring and mapping tutorial, Vers. 2, May 1993
103 !!
104 !!
105 !!    AUTHOR
106 !!    ------
107 !!      
108 !!      J. Duron    * Laboratoire d'Aerologie *
109 !!
110 !!    MODIFICATIONS
111 !!    -------------
112 !!      Original       06/06/94
113 !!      Updated   PM   12/12/94
114 !-------------------------------------------------------------------------------
115 !
116 !*       0.    DECLARATIONS
117 !              ------------
118 !
119 USE MODD_NMGRID
120 USE MODD_RADAR
121 USE MODE_GRIDPROJ
122 USE MODD_COORD
123 USE MODD_MASK3D
124 USE MODD_TRAJ3D
125 USE MODD_RESOLVCAR
126 USE MODD_GRID1
127 USE MODD_GRID
128 USE MODD_CTL_AXES_AND_STYL
129 USE MODN_NCAR
130 USE MODN_PARA
131 USE MODI_CREATLINK
132 USE MODI_WRITEDIR
133
134 IMPLICIT NONE
135
136 COMMON/EPAISCONT/ZLWCONT
137 COMMON/FDC/IFDC
138
139 INTEGER :: K
140 !
141 !*       0.1   Local variables
142 !
143 REAL :: ZLWCONT
144 REAL :: ZLAT2, ZLAT, ZLON
145 REAL,SAVE :: ZZLAT, ZZLON
146 REAL :: ZPL1, ZPL2, ZPL3, ZPL4
147 REAL :: ZX1, ZX2, ZY1, ZY2, ZXX1, ZXX2, ZYY1, ZYY2
148 REAL :: ZU, ZV, ZSZ, ZPOS, ZCENT
149 REAL :: ZI, ZJ, ZX, ZY
150 INTEGER :: ICONVI, ICONVJ
151 REAL :: ZXMIN, ZXMAX,ZYMIN, ZYMAX
152 REAL :: ZWIDTH
153 CHARACTER(LEN=40),SAVE :: YCAR40=' '
154 CHARACTER(LEN=80),SAVE :: YCAR80=' '
155 CHARACTER(LEN=1)       :: YSYMB
156 CHARACTER(LEN=20)      :: YNOM
157 CHARACTER(LEN=10) :: FORMAX, FORMAY
158
159 INTEGER :: JIP, IT, IDUM, IRPK, JLPCAR,JIJCAR, J,IIT
160 INTEGER :: IERR, IPOS, ICOLS, ICOLN
161 INTEGER :: IFDC
162 !!!!!!!!!!!!!! Modif VD (29/10/2003)
163 INTEGER :: IDOT,IPT,IDOT0,IPT0,JLOOP
164 REAL, DIMENSION(200000) :: ZZU,ZZV,ZZU0,ZZV0
165 !!!!!!!!!!!!!! fin Modif VD
166 LOGICAL :: GIND,GCONF
167 !
168 !-------------------------------------------------------------------------------
169 !
170 !*       1.   SETS CARTOGRAPHIC PROJECTION AND DRAWS BACKGROUND MAP
171 !             -----------------------------------------------------
172 !
173 !
174 !*       1.1  If Lambert case, computes the second reference latitude
175 !            (required by the NCAR framework for Lambert) 
176 !
177 IF(L2CONT)THEN
178   IFDC=NIFDC
179 ELSE
180   IF(K == 1)THEN
181     IFDC=0
182   ELSE
183     IFDC=NIFDC
184   ENDIF
185 ENDIF
186 !!!!IFDC=NIFDC
187 IF(ABS(XRPK).GT.0..AND.ABS(XRPK).LT.1.)THEN
188   IF(NVERBIA >= 5)THEN
189     print *,' bcgrd XLAT0,XRPK ',XLAT0,XRPK
190   ENDIF
191   ZLAT2=LATREF2(XLAT0,XRPK)
192   IF(NVERBIA >= 5)THEN
193     print *,' bcgrd ZLAT2 ',ZLAT2
194   ENDIF
195 ENDIF
196 !
197 !*       1.2  Convert display window diagonal to cartographic coordinates
198 !
199 ! (The main diagonal of the displayed domain is given by Meso-NH
200 !  indexes NIINF-NJINF, NISUP-NJSUP)
201 !
202 !ZXMIN=100000.
203 ZXMIN=XXX(NIINF,NMGRID)
204 ZYMIN=XXY(NJINF,NMGRID)
205 !ZXMAX=2500000.
206 ZXMAX=XXX(NISUP,NMGRID)
207 ZYMAX=XXY(NJSUP,NMGRID)
208 IF(NVERBIA >= 2)THEN
209   print *,' ** bcg NIINF,NJINF,NMGRID,NISUP,NJSUP ',NIINF,NJINF,NMGRID,NISUP,NJSUP
210 ENDIF
211 !
212 CALL SM_LATLON_S(XLATORI,XLONORI,ZXMIN,ZYMIN,ZPL1,ZPL2)
213 CALL SM_LATLON_S(XLATORI,XLONORI,ZXMAX,ZYMAX,ZPL3,ZPL4)
214 IF(NVERBIA >= 2)THEN
215   print *,' ZXMIN,ZYMIN,ZXMAX,ZYMAX ',ZXMIN,ZYMIN,ZXMAX,ZYMAX
216   print *,' XLATORI,XLONORI,ZPL1,ZPL2,ZPL3,ZPL4 ',XLATORI,XLONORI,ZPL1,ZPL2,ZPL3,ZPL4
217   print *,' XLATO,XLONO ',XLAT0,XLON0
218 ENDIF
219 !
220 !*       1.3   Selects a standard NCAR continental/state outline mode
221 !*             and visual details
222 !
223 ! -> NCAR default : call mapstc('OU','PO')
224 ! ->     None      : call mapstc('OU','NO')
225 !
226 !IF (NIFDC.NE.1)THEN
227 IF (NIFDC.EQ.1 .OR. NIFDC.EQ.3)THEN
228   CALL MAPSTC('OU','PO')
229 ELSE
230   CALL MAPSTC('OU','NO')
231 ENDIF
232 !
233 CALL MAPSTI('DO',0)        ! Solid coastlines
234 !CALL MAPSTI('DO',1)        ! Dotted coastlines
235 CALL MAPSTI('RE',10000)    ! Plotter resolution
236 CALL MAPSTI('DL',0)        ! MAPIT draws solid lines
237 !CALL MAPSTI('DL',1)        ! MAPIT draws dotted lines
238 !CALL MAPSTI('GR',NIGRNC)   ! Grid spacing in degrees
239 if(nverbia > 0)then
240   print *,' **bcgrd AV CALL MAPSTI(GR,0)'
241 endif
242 IF(K == 1)THEN
243   CALL MAPSTI('GR',0)   ! Grid spacing in degrees
244 ELSE IF(K == 2)THEN
245   IF(LANIMK )THEN
246   ELSE
247   CALL MAPSTI('GR',NIGRNC)   ! Grid spacing in degrees
248   ENDIF
249 ENDIF
250 !
251 !*       1.4   Selects NCAR cartographic projection
252 !
253 IRPK=2
254 IF(XRPK.EQ.0.)IRPK=0
255 ! Oct 99 Pole Sud Proj. stereog.
256 IF(ABS(XRPK).EQ.1.)IRPK=1
257 ! Oct 99 Pole Sud Proj. stereog.
258 !IF(XRPK.EQ.1.)IRPK=1
259 !write(0,*)' BCGRD IRPK ',IRPK
260 !
261 SELECT CASE(IRPK)
262   CASE(0)  
263     CALL MAPROJ('ME',0.,XLON0,XBETA)               ! Mercator
264   CASE(1)
265     CALL MAPROJ('ST',90.,XLON0,-XBETA)             ! Polar Stereographic
266 ! Oct 99 Pole Sud Proj. stereog.
267 !  BESOIN DE VERIFIER si dans ce cas on met XBETA ou -XBETA
268     IF(XRPK < 0.)CALL MAPROJ('ST',-90.,XLON0,-XBETA)
269 ! Oct 99 Pole Sud Proj. stereog.
270   CASE DEFAULT
271     CALL MAPROJ('LC',XLAT0,XLON0+XBETA/XRPK,ZLAT2) ! Lambert
272 END SELECT
273 !
274 !*       1.5   Sets map transformation, map display window
275 !*             and draws lat-lon grid
276 !
277 IF(LVPTUSER)THEN
278   CALL MAPPOS(XVPTL,XVPTR,XVPTB,XVPTT)
279 ELSE
280   CALL MAPPOS(.05,.95,.05,.95)
281 ENDIF
282 CALL MAPSET('CO',ZPL1,ZPL2,ZPL3,ZPL4)
283 IF(XLWCONT /= 0.)THEN
284   ZLWCONT=XLWCONT
285 ELSE
286   ZLWCONT=5.
287 ENDIF
288 !
289 ! Pour V4.1.1 A la place de CALL MAPDRW a mettre en commentaire
290 ! Non c'est fait EN PRINCIPE dans MAPDRW qui est inclus dans le fichier frame
291 !CALL MAPINT
292 !CALL MAPGRD
293 !CALL MAPLBL
294 !CALL MPLNDR('Earth..1',3)
295 if(nverbia > 0)then
296   print *,' **bcgrd AV CALL MAPDRW'
297 endif
298 CALL MAPDRW
299 !
300 !*      1.6    Use of non-NCAR coastline data sets if available 
301 !*             (ex. IGN ones) on fortran unit 1
302 !
303 ! NOTICE: The use of fortran unit 1 here does not
304 !         fit Meso-NH file access norm
305 !
306 IF((NIFDC.EQ.2 .OR. NIFDC.EQ.3) .AND. K.EQ.2)THEN
307   IF(YCAR40(1:LEN(YCAR40)) == ' ')THEN
308     print *,'ENTREZ le nom du fichier des contours (geograp. ou polit....) '
309     !print *,' avec un PATH ABSOLU  (40 caracteres maximum) et entre quotes'
310     print *,' entre quotes (40 caracteres maximum)'
311     READ(5,*)YCAR40
312     YCAR40=ADJUSTL(YCAR40)
313     YCAR80(1:1)="'"
314     YCAR80(2:LEN_TRIM(YCAR40)+1)=YCAR40(1:LEN_TRIM(YCAR40))
315     YCAR80(LEN_TRIM(YCAR40)+2:LEN_TRIM(YCAR40)+2)="'"
316     !WRITE(NDIR,'(A80)')YCAR80
317     CALL WRITEDIR(NDIR,YCAR80)
318     CALL CREATLINK('DIRFDC',YCAR40(1:LEN_TRIM(YCAR40)),'CREAT',NVERBIA)
319 ! print *,YCAR40
320   ENDIF
321   OPEN(1,FILE=YCAR40(1:LEN_TRIM(YCAR40)),FORM='FORMATTED',STATUS='OLD')  ! Opens coastline file
322 !  OPEN(1,FILE='/u/m/mrmh/mrmh005/mesonh/data/cotign')  ! Opens coastline file
323   CALL GSCLIP(0)
324   CALL GQLWSC(IERR,ZWIDTH)
325   IF(XLWCONT /= 0.)THEN
326     ZLWCONT=XLWCONT
327   ELSE
328     ZLWCONT=4.
329   ENDIF
330   CALL GSLWSC(ZLWCONT)
331 !
332 !!!!!!!!! MODIF VD TO introduce dashed lines with NIFDC=2  (29/10/2003)
333 ! Initial coordinate transformation saved
334   CALL GETSET(ZX1,ZX2,ZY1,ZY2,ZXX1,ZXX2,ZYY1,ZYY2,IDUM)
335 ! Initial coordinate transformation restored
336   CALL SET(ZX1,ZX2,ZY1,ZY2,ZXMIN,ZXMAX,ZYMIN,ZYMAX,IDUM)
337    IPT=0
338    IPT0=0
339    IDOT=838860 ! dashed pattern used for dashed lines (IT=2 or 3)
340    IDOT0=65535 ! dashed pattern used for solid lines (IT=0 or 1)
341     DO JIP=1,200000
342       READ(1,*,END=50)ZLAT,ZLON,IT                ! Reads coastline file
343       IF(JIP == 1)print *,' 1er enr. ',ZLAT,ZLON,IT 
344 !     IF(ABS(ZZLAT-ZLAT) > .2 .OR. ABS(ZZLON-ZLON) > .2)THEN
345 !       print *,'ZZLAT,ZLAT,ZZLON,ZLON ',ZZLAT,ZLAT,ZZLON,ZLON
346 !       IT=0
347 !       CALL MAPIT(ZLAT,ZLON,IT)             ! Draws IGN one coastline point
348 !     ELSE
349 !       CALL MAPIT(ZLAT,ZLON,IT)             ! Draws IGN one coastline point
350 !     ENDIF
351       !ZZLAT=ZLAT
352       !ZZLON=ZLON
353       CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZU,ZV)
354 !
355       IF (IT==2 .OR. IT==3) THEN
356         IF (IT==2) THEN
357           IF (IPT>0) THEN
358            CALL DASHDB(IDOT) 
359            CALL CURVED(ZZU,ZZV,IPT)
360           ENDIF
361           IPT=0
362           IF ((ZU>= ZXMIN).AND.(ZU<=ZXMAX).AND.(ZV>=ZYMIN).AND.(ZV<=ZYMAX)) THEN
363             IPT=IPT+1
364             ZZU(IPT)=ZU
365             ZZV(IPT)=ZV 
366           ENDIF
367         ELSE
368           IF ((ZU>= ZXMIN).AND.(ZU<=ZXMAX).AND.(ZV>=ZYMIN).AND.(ZV<=ZYMAX)) THEN
369             IPT=IPT+1
370             ZZU(IPT)=ZU
371             ZZV(IPT)=ZV 
372           END IF
373         ENDIF
374       ELSE
375  
376         IF (IT==0) THEN  ! begin of the definition of the 
377           IF (IPT0>0) THEN
378             CALL DASHDB(IDOT0) 
379             CALL CURVED(ZZU0,ZZV0,IPT0)
380           ENDIF
381           IPT0=0
382           IF ((ZU>= ZXMIN).AND.(ZU<=ZXMAX).AND.(ZV>=ZYMIN).AND.(ZV<=ZYMAX)) THEN
383             IPT0=IPT0+1
384             ZZU0(IPT0)=ZU
385             ZZV0(IPT0)=ZV 
386           ENDIF
387         ELSE
388           IF ((ZU>= ZXMIN).AND.(ZU<=ZXMAX).AND.(ZV>=ZYMIN).AND.(ZV<=ZYMAX)) THEN
389             IPT0=IPT0+1
390             ZZU0(IPT0)=ZU
391             ZZV0(IPT0)=ZV 
392           END IF
393         ENDIF
394       ENDIF
395 !
396     ENDDO
397 50 CONTINUE
398 ! finish to draw the last curves :  
399       print *,' Dernier enr. ',ZLAT,ZLON,IT 
400     !CALL MAPIQ
401     IF (IPT>0) THEN
402       CALL DASHDB(IDOT)
403       CALL CURVED(ZZU,ZZV,IPT)
404     ENDIF
405     IF (IPT0>0) THEN
406       CALL DASHDB(IDOT0)
407       CALL CURVED(ZZU0,ZZV0,IPT0)
408     ENDIF
409 !!!!!!!!!!!!!!!!!!! fin modif VD
410   CALL GSCLIP(1)                           ! Clipping of extra coastline
411   CLOSE(1)
412   CALL GSLN(1)                             ! restore solid line
413   CALL GSLWSC(ZWIDTH)
414 ENDIF
415 !
416 !*      1.7    Formats and write Map axes with appropriate labels
417 !*             and axes scale labels 
418 !
419 ! Initial coordinate transformation saved
420 CALL GETSET(ZX1,ZX2,ZY1,ZY2,ZXX1,ZXX2,ZYY1,ZYY2,IDUM)
421 ! Sets NCAR user coordinates
422 GIND=.NOT.LGEOG .OR. &
423 !!!!!!!!!!!!!!! JOEL!!!!!!!!!!!!
424      (.NOT.LGEOG .AND. &
425       (LXYZ00 .OR. LMASK3D .OR. LMASK3D_XY .OR. LMASK3D_XZ .OR. LMASK3D_YZ &
426 !      .OR. LMARKER .OR. LTRAJ3D .OR. LFLUX3D)
427        .OR. LMSKTOP .OR. LTRAJ3D .OR. LFLUX3D) .AND. LINDAX )
428 GCONF= .NOT.LGEOG .AND. &
429        (LXYZ00 .OR. LMASK3D .OR. LMASK3D_XY .OR. LMASK3D_XZ .OR. LMASK3D_YZ &
430 !      .OR. LMARKER .OR. LTRAJ3D .OR. LFLUX3D)
431        .OR. LMSKTOP .OR. LTRAJ3D .OR. LFLUX3D) .AND. .NOT.LINDAX 
432 IF (GCONF) GIND=.FALSE.
433 !!!!!!!!!!!!!!! JOEL!!!!!!!!!!!!
434
435 ! limites du domaine en indices de grille
436 IF(GIND)THEN
437    CALL SET(ZX1,ZX2,ZY1,ZY2,FLOAT(NIINF),FLOAT(NISUP),  &
438         FLOAT(NJINF),FLOAT(NJSUP),IDUM)
439 !>>>>>>>>>>>>This section is to be revised***********************
440
441   FORMAX='          '
442   IF(LFMTAXEX)THEN
443     FORMAX="("//CFMTAXEX(1:LEN_TRIM(CFMTAXEX))//")"
444   ELSE
445     FORMAX='(F5.1)'
446   ENDIF
447   FORMAY='          '
448   IF(LFMTAXEY)THEN
449     FORMAY="("//CFMTAXEY(1:LEN_TRIM(CFMTAXEY))//")"
450   ELSE
451     FORMAY='(F5.1)'
452   ENDIF
453   CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,0,0,0)
454 ! CALL LABMOD(FORMAX,FORMAY,0,0,10,10,0,0,0)
455 ! CALL LABMOD('(F5.1)','(F5.1)',0,0,10,10,0,0,0)
456 !CALL GASETI('LTY',1)
457
458   IF(NCHPCITVXMJ /= 0 .OR. NCHPCITVYMJ /=0 .OR. NCHPCITVXMN /= 0 .OR. &
459      NCHPCITVXMN /= 0)THEN
460 !Avril 2002
461     IF(LNOLABELX .AND. LNOLABELY)THEN
462       CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,0,0,5,0.,0.)
463     ELSEIF(LNOLABELX .AND. .NOT.LNOLABELY)THEN
464       CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,0,1,5,0.,0.)
465     ELSEIF(.NOT.LNOLABELX .AND. LNOLABELY)THEN
466       CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,1,0,5,0.,0.)
467     ELSE
468       CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,1,1,5,0.,0.)
469     ENDIF
470 !Avril 2002
471
472   ELSE
473     IF(NISUP > 99)THEN
474       FORMAX='          '
475       IF(LFMTAXEX)THEN
476         FORMAX="("//CFMTAXEX(1:LEN_TRIM(CFMTAXEX))//")"
477       ELSE
478         FORMAX='(I4)'
479       ENDIF
480       FORMAY='          '
481       IF(LFMTAXEY)THEN
482         FORMAY="("//CFMTAXEY(1:LEN_TRIM(CFMTAXEY))//")"
483       ELSE
484         FORMAY='(I2)'
485       ENDIF
486       CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,0,0,0)
487 !     CALL LABMOD(FORMAX,FORMAY,0,0,10,10,0,0,0)
488 !     CALL LABMOD('(I3)','(I2)',0,0,10,10,0,0,0)
489 !     CALL LABMOD('(I3)','(I2)',3,2,10,10,0,0,0)
490       IF(NJSUP > 99)THEN
491         FORMAY='          '
492         IF(LFMTAXEY)THEN
493           FORMAY="("//CFMTAXEY(1:LEN_TRIM(CFMTAXEY))//")"
494         ELSE
495           FORMAY='(I4)'
496         ENDIF
497         CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,0,0,0)
498 !       CALL LABMOD(FORMAX,FORMAY,0,0,10,10,0,0,0)
499 !       CALL LABMOD('(I3)','(I3)',0,0,10,10,0,0,0)
500 !       CALL LABMOD('(I3)','(I3)',3,3,10,10,0,0,0)
501       ENDIF
502     ELSE  
503       FORMAX='          '
504       IF(LFMTAXEX)THEN
505         FORMAX="("//CFMTAXEX(1:LEN_TRIM(CFMTAXEX))//")"
506       ELSE
507         FORMAX='(I2)'
508       ENDIF
509       FORMAY='          '
510       IF(LFMTAXEY)THEN
511         FORMAY="("//CFMTAXEY(1:LEN_TRIM(CFMTAXEY))//")"
512       ELSE
513         FORMAY='(I2)'
514       ENDIF
515       CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,0,0,0)
516 !     CALL LABMOD(FORMAX,FORMAY,0,0,10,10,0,0,0)
517 !     CALL LABMOD('(I2)','(I2)',0,0,10,10,0,0,0)
518 !     CALL LABMOD('(I2)','(I2)',2,2,10,10,0,0,0)
519       IF(NJSUP > 99)THEN
520         FORMAY='          '
521         IF(LFMTAXEY)THEN
522           FORMAY="("//CFMTAXEY(1:LEN_TRIM(CFMTAXEY))//")"
523         ELSE
524           FORMAY='(I4)'
525         ENDIF
526         CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,0,0,0)
527 !       CALL LABMOD(FORMAX,FORMAY,0,0,10,10,0,0,0)
528 !       CALL LABMOD('(I2)','(I3)',0,0,10,10,0,0,0)
529 !       CALL LABMOD('(I2)','(I3)',2,3,10,10,0,0,0)
530       ENDIF
531     ENDIF
532 !Avril 2002
533     IF(LNOLABELX .AND. LNOLABELY)THEN
534       CALL GRIDAL(1,NISUP-NIINF,1,NJSUP-NJINF,0,0,5,0.,0.)
535     ELSEIF(LNOLABELX .AND. .NOT.LNOLABELY)THEN
536       CALL GRIDAL(1,NISUP-NIINF,1,NJSUP-NJINF,0,1,5,0.,0.)
537     ELSEIF(.NOT.LNOLABELX .AND. LNOLABELY)THEN
538       CALL GRIDAL(1,NISUP-NIINF,1,NJSUP-NJINF,1,0,5,0.,0.)
539     ELSE
540       CALL GRIDAL(1,NISUP-NIINF,1,NJSUP-NJINF,1,1,5,0.,0.)
541       !CALL PERIM(NISUP-NIINF,1,NJSUP-NJINF,1)
542     ENDIF
543 !Avril 2002
544   ENDIF
545 ENDIF
546 !
547 !!!!!!!!!!!!!!! JOEL!!!!!!!!!!!!
548 ! limites du domaine en coord. conf. (pour lachers de part. LMASK3D)
549 IF(GCONF) THEN
550   CALL SET(ZX1,ZX2,ZY1,ZY2,ZXMIN,ZXMAX,ZYMIN,ZYMAX,1)
551   CALL LABMOD('(F8.0)','(F8.0)',0,0,NSZLBX,NSZLBY,12,0,0)
552   CALL GRIDAL(1,NISUP-NIINF,1,NJSUP-NJINF,1,1,5,0.,0.)
553 ENDIF
554 !!!!!!!!!!!!!!! JOEL!!!!!!!!!!!!
555 !
556 ! limites du domaine en lat/lon
557 IF (LGEOG) THEN
558   CALL SET(ZX1,ZX2,ZY1,ZY2,ZPL2,ZPL4,ZPL1,ZPL3,IDUM)
559   FORMAY='          '
560   IF(LFMTAXEY)THEN
561     FORMAY="("//CFMTAXEY(1:LEN_TRIM(CFMTAXEY))//")"
562   ELSE
563     FORMAY='(F5.1)'
564   ENDIF
565   IF(ZPL2 < -99. .OR. ZPL4 < -99.)THEN
566     FORMAX='          '
567     IF(LFMTAXEX)THEN
568       FORMAX="("//CFMTAXEX(1:LEN_TRIM(CFMTAXEX))//")"
569     ELSE
570       FORMAX='(F6.1)'
571     ENDIF
572 ! Ai mis 12 pour rapprocher les labels Y de l'axe; sinon troncature
573     CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,12,0,0)
574 !   CALL LABMOD(FORMAX,FORMAY,0,0,10,10,12,0,0)
575 !   CALL LABMOD('(F6.1)','(F5.1)',0,0,10,10,12,0,0)
576 !   CALL LABMOD('(F6.1)','(F5.1)',6,5,10,10,0,0,0)
577   ELSE
578     FORMAX='          '
579     IF(LFMTAXEX)THEN
580       FORMAX="("//CFMTAXEX(1:LEN_TRIM(CFMTAXEX))//")"
581     ELSE
582       FORMAX='(F6.2)'
583     ENDIF
584     CALL LABMOD(FORMAX,FORMAY,0,0,NSZLBX,NSZLBY,12,0,0)
585 !   CALL LABMOD(FORMAX,FORMAY,0,0,10,10,12,0,0)
586 !   CALL LABMOD('(F6.2)','(F5.1)',0,0,10,10,12,0,0)
587 !   CALL LABMOD('(F6.2)','(F5.1)',6,5,10,10,0,0,0)
588   ENDIF
589 !Avril 2002
590     IF(LNOLABELX .AND. LNOLABELY)THEN
591   CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,0,0,5,0.,0.)
592     ELSEIF(LNOLABELX .AND. .NOT.LNOLABELY)THEN
593   CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,0,1,5,0.,0.)
594     ELSEIF(.NOT.LNOLABELX .AND. LNOLABELY)THEN
595   CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,1,0,5,0.,0.)
596     ELSE
597   CALL GRIDAL(NCHPCITVXMJ,NCHPCITVXMN,NCHPCITVYMJ,NCHPCITVXMN,1,1,5,0.,0.)
598     ENDIF
599 !Avril 2002
600 ENDIF
601 ! Initial coordinate transformation restored
602 CALL SET(ZX1,ZX2,ZY1,ZY2,ZXX1,ZXX2,ZYY1,ZYY2,IDUM)
603 !
604 !*     1.8    A series of landmarks is added to the plot when required
605 !
606 !!! Enleve le 30/8/99 pour travailler avec les coordonnees conformes ci-apres
607 !   verifie que idem
608 !IF(NLPCAR.GE.1)THEN
609 ! DO JLPCAR=1,NLPCAR
610 !   CALL MAPTRN(XLATCAR(JLPCAR),XLONCAR(JLPCAR),ZU,ZV)
611 !>>>>>>>May be, this section is to be revised*******************
612 !   CALL NGWSYM('N',8,ZU,ZV,.012,1,0)
613 ! Obsolete   CALL PWRITX(ZU,ZV,'''KGU''-',6,20,0,0)
614 ! ENDDO
615 !ENDIF
616 ! Initial coordinate transformation restored
617 CALL SET(ZX1,ZX2,ZY1,ZY2,ZXMIN,ZXMAX,ZYMIN,ZYMAX,IDUM)
618 if(nverbia > 0)then
619   print *,' **bcgrd AP CALL SET'
620 endif
621
622 IF(K == 2)THEN
623 IF(NLPCAR.GE.1)THEN
624   IF(.NOT.LCOLAREA .AND. .NOT.LCOLINE)THEN
625     call tabcol_fordiachro
626   ENDIF
627   IF(LUMVM .OR. LUTVT .AND. NSUPERDIA == 1)THEN
628     call tabcol_fordiachro
629   ENDIF
630   DO JLPCAR=1,NLPCAR
631     ZLAT=XLATCAR(JLPCAR)
632     ZLON=XLONCAR(JLPCAR)
633     YSYMB=CSYMCAR(JLPCAR)
634     ZPOS=XPOSNOM(JLPCAR)
635     ICOLS=ICOLSYM(JLPCAR)
636     ICOLN=ICOLNOM(JLPCAR)
637     IF(XSZSYM(JLPCAR) /= 0.)THEN
638       ZSZ=XSZSYM(JLPCAR)
639       IF(ZSZ == 9999.)ZSZ=.012
640     ELSE
641       ZSZ=.012
642     ENDIF
643     CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZU,ZV)
644 !   CALL GSTXCI(ICOLS)
645     CALL PCSETI('OC',ICOLS)
646     IF(YSYMB == '.')THEN
647       CALL NGWSYM('N',8,ZU,ZV,ZSZ,ICOLS,0)
648 !     CALL NGWSYM('N',8,ZU,ZV,ZSZ,1,0)
649     ELSE
650       CALL PCSETI('OF',2)
651       CALL PCSETR('OL',1.5)
652       CALL PLCHHQ(ZU,ZV,YSYMB,ZSZ,0.,0.)
653       CALL PCSETI('OF',0)
654       CALL PCSETR('OL',0.)
655     ENDIF
656     CALL PCSETI('OC',1)
657     IF(XSZNOM(JLPCAR) /= 0.)THEN
658       ZSZ=XSZNOM(JLPCAR)
659       IF(ZSZ == 9999.)ZSZ=.012
660     ELSE
661       ZSZ=.012
662     ENDIF
663     IPOS=ZPOS
664 !   print *,' ZSZ NOM ',ZSZ
665     SELECT CASE(IPOS)
666       CASE(0)
667         ZCENT=-1.
668         ZU=ZU+ZSZ*1.1*(ZXMAX-ZXMIN)
669       CASE(45)
670         ZCENT=-1.
671         ZU=ZU+ZSZ*1.0*(ZXMAX-ZXMIN)
672         ZV=ZV+ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
673       CASE(90)
674         ZCENT=0.
675         ZV=ZV+ZSZ*1.5*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
676 !       ZV=ZV+ZSZ*1.5*(ZYMAX-ZYMIN)
677       CASE(135)
678         ZCENT=1.
679         ZU=ZU-ZSZ*1.0*(ZXMAX-ZXMIN)
680         ZV=ZV+ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
681 !       ZV=ZV+ZSZ*1.0*(ZYMAX-ZYMIN)
682       CASE(180)
683         ZCENT=1.
684         ZU=ZU-ZSZ*1.1*(ZXMAX-ZXMIN)
685       CASE(225)
686         ZCENT=1.
687         ZU=ZU-ZSZ*1.0*(ZXMAX-ZXMIN)
688         ZV=ZV-ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
689 !       ZV=ZV-ZSZ*1.0*(ZYMAX-ZYMIN)
690       CASE(270)
691         ZCENT=0.
692         ZV=ZV-ZSZ*1.5*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
693 !       ZV=ZV-ZSZ*1.5*(ZYMAX-ZYMIN)
694       CASE(315)
695         ZCENT=-1.
696         ZU=ZU+ZSZ*1.0*(ZXMAX-ZXMIN)
697         ZV=ZV-ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
698 !       ZV=ZV-ZSZ*1.0*(ZYMAX-ZYMIN)
699     END SELECT 
700     IF(CNOMCAR(JLPCAR) /= ' ')THEN
701       YNOM=CNOMCAR(JLPCAR)
702       YNOM=ADJUSTL(YNOM)
703       CALL PCSETI('OF',2)
704       CALL PCSETI('OC',ICOLN)
705       !CALL PCSETR('OL',1.5)
706       !MODIF SYLVIE D.: epaisseur des caracteres de CNOMSYM -> XLWNOM
707       CALL PCSETR('OL',XLWCONT)
708 !     CALL GSTXCI(ICOLN)
709 !     CALL GSPLCI(ICOLN)
710       CALL PLCHHQ(ZU,ZV,YNOM(1:LEN_TRIM(YNOM)),ZSZ,0.,ZCENT)
711 !     CALL PLCHHQ(ZU,ZV+ZSZ*1.5*(ZYMAX-ZYMIN),YNOM(1:LEN_TRIM(YNOM)),ZSZ,0.,ZCENT)
712     ENDIF
713     CALL PCSETI('OF',0)
714     CALL PCSETR('OL',0.)
715     CALL PCSETI('OC',1)
716     CALL GSTXCI(1)
717   ENDDO
718 ENDIF
719 IF(NIJCAR.GE.1)THEN
720   IF(.NOT.LCOLAREA .AND. .NOT.LCOLINE)THEN
721     call tabcol_fordiachro
722   ENDIF
723   DO JIJCAR=1,NIJCAR
724     ZI=XICAR(JIJCAR)
725     ZJ=XJCAR(JIJCAR)
726     print *,' **bcgrd_fordiachro ZI,ZJ ',ZI,ZJ
727     YSYMB=CSYMCAR(JIJCAR)
728     ZPOS=XPOSNOM(JIJCAR)
729     ICOLS=ICOLSYM(JIJCAR)
730     ICOLN=ICOLNOM(JIJCAR)
731     IF(XSZSYM(JIJCAR) /= 0.)THEN
732       ZSZ=XSZSYM(JIJCAR)
733       IF(ZSZ == 9999.)ZSZ=.012
734     ELSE
735       ZSZ=.012
736     ENDIF
737     ICONVI=INT(ZI)
738     ICONVJ=INT(ZJ)
739     if(nverbia > 0)then
740     print *,' **bcgrd_fordiachro ICONVI, ICONVJ ',ICONVI,ICONVJ
741     endif
742     ZX=XXX(ICONVI,NMGRID)+(XXX(MIN(ICONVI+1,SIZE(XXX,1)),NMGRID)-XXX(ICONVI,NMGRID))*(ZI-FLOAT(ICONVI))
743     ZY=XXY(ICONVJ,NMGRID)+(XXY(MIN(ICONVJ+1,SIZE(XXY,1)),NMGRID)-XXY(ICONVJ,NMGRID))*(ZJ-FLOAT(ICONVJ))
744     if(nverbia > 0)then
745     print *,' **bcgrd_fordiachro ZX,ZY ',ZX,ZY
746     endif
747     CALL PCSETI('OC',ICOLS)
748     IF(YSYMB == '.')THEN
749       CALL NGWSYM('N',8,ZX,ZY,ZSZ,ICOLS,0)
750     ELSE
751       CALL PCSETI('OF',2)
752       CALL PCSETR('OL',1.5)
753       CALL PLCHHQ(ZX,ZY,YSYMB,ZSZ,0.,0.)
754       CALL PCSETI('OF',0)
755       CALL PCSETR('OL',0.)
756     ENDIF
757     CALL PCSETI('OC',1)
758     IF(XSZNOM(JIJCAR) /= 0.)THEN
759       ZSZ=XSZNOM(JIJCAR)
760       IF(ZSZ == 9999.)ZSZ=.012
761     ELSE
762       ZSZ=.012
763     ENDIF
764     IPOS=ZPOS
765     SELECT CASE(IPOS)
766       CASE(0)
767         ZCENT=-1.
768         ZX=ZX+ZSZ*1.1*(ZXMAX-ZXMIN)
769       CASE(45)
770         ZCENT=-1.
771         ZX=ZX+ZSZ*1.0*(ZXMAX-ZXMIN)
772         ZY=ZY+ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
773       CASE(90)
774         ZCENT=0.
775         ZY=ZY+ZSZ*1.5*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
776       CASE(135)
777         ZCENT=1.
778         ZX=ZX-ZSZ*1.0*(ZXMAX-ZXMIN)
779         ZY=ZY+ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
780       CASE(180)
781         ZCENT=1.
782         ZX=ZX-ZSZ*1.1*(ZXMAX-ZXMIN)
783       CASE(225)
784         ZCENT=1.
785         ZX=ZX-ZSZ*1.0*(ZXMAX-ZXMIN)
786         ZY=ZY-ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
787       CASE(270)
788         ZCENT=0.
789         ZY=ZY-ZSZ*1.5*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
790       CASE(315)
791         ZCENT=-1.
792         ZX=ZX+ZSZ*1.0*(ZXMAX-ZXMIN)
793         ZY=ZY-ZSZ*1.0*(MAX(ZXMAX-ZXMIN,ZYMAX-ZYMIN))
794     END SELECT 
795     IF(CNOMCAR(JIJCAR) /= ' ')THEN
796       YNOM=CNOMCAR(JIJCAR)
797       YNOM=ADJUSTL(YNOM)
798       CALL PCSETI('OF',2)
799       CALL PCSETI('OC',ICOLN)
800       CALL PCSETR('OL',1.5)
801       CALL PLCHHQ(ZX,ZY,YNOM(1:LEN_TRIM(YNOM)),ZSZ,0.,ZCENT)
802     ENDIF
803     CALL PCSETI('OF',0)
804     CALL PCSETR('OL',0.)
805     CALL PCSETI('OC',1)
806     CALL GSTXCI(1)
807   ENDDO
808 ENDIF
809 IF(LRADAR)THEN
810   CALL GQLWSC(IERR,ZWIDTH)
811   ZSZ=.012
812   CALL GSLWSC(3.)
813   IF(NPORTRAD1 /= 0)THEN
814     ZLAT=XLATRAD1
815     ZLON=XLONRAD1
816     YSYMB=CSYMRAD1
817     CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZU,ZV)
818     CALL PLCHHQ(ZU,ZV,YSYMB,ZSZ,0.,0.)
819     DO J=1,NPORTRAD1
820       CALL TRACIRCLE(ZU,ZV,XPORTRAD1(J),XLWRAD1(J))
821       CALL SFLUSH
822     ENDDO
823   ENDIF
824   IF(NPORTRAD2 /= 0)THEN
825     ZLAT=XLATRAD2
826     ZLON=XLONRAD2
827     YSYMB=CSYMRAD2
828     CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZU,ZV)
829     CALL PLCHHQ(ZU,ZV,YSYMB,ZSZ,0.,0.)
830     DO J=1,NPORTRAD2
831       CALL TRACIRCLE(ZU,ZV,XPORTRAD2(J),XLWRAD2(J))
832       CALL SFLUSH
833     ENDDO
834   ENDIF
835   IF(NPORTRAD3 /= 0)THEN
836     ZLAT=XLATRAD3
837     ZLON=XLONRAD3
838     YSYMB=CSYMRAD3
839     CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZU,ZV)
840     CALL PLCHHQ(ZU,ZV,YSYMB,ZSZ,0.,0.)
841     DO J=1,NPORTRAD3
842       CALL TRACIRCLE(ZU,ZV,XPORTRAD3(J),XLWRAD3(J))
843       CALL SFLUSH
844     ENDDO
845   ENDIF
846   IF(NPORTRAD4 /= 0)THEN
847     ZLAT=XLATRAD4
848     ZLON=XLONRAD4
849     YSYMB=CSYMRAD4
850     CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZU,ZV)
851     CALL PLCHHQ(ZU,ZV,YSYMB,ZSZ,0.,0.)
852     DO J=1,NPORTRAD4
853       CALL TRACIRCLE(ZU,ZV,XPORTRAD4(J),XLWRAD4(J))
854       CALL SFLUSH
855     ENDDO
856   ENDIF
857   CALL GSLWSC(ZWIDTH)
858 ENDIF
859
860 ENDIF
861 !
862 !----------------------------------------------------------------------
863 !
864 !*    2.     EXIT
865 !            ----
866 !
867 RETURN
868 END SUBROUTINE BCGRD_FORDIACHRO