source: LMDZ.3.3/trunk/libf/dyn3d/ord_coordm.F @ 5306

Last change on this file since 5306 was 269, checked in by lmdz, 23 years ago

Remplacement des allocates par des dimensionnements classiques. LeVan?
LF

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 2.5 KB
RevLine 
[259]1       SUBROUTINE ord_coordm ( nmax, xi, xo, jjm, jmods, decrois )
2
3c   ....  Auteur :  P. Le Van  ....
4
5c   ... Reordonne eventuellement les coordonnees de la grille modele ...
6c
7       IMPLICIT NONE
8
9c    .....  Arguments  en entree  .....
10
[269]11       INTEGER nmax,jjm
12       REAL xi(nmax)
[259]13
14c    .....  Arguments  en sortie  .....
15c
[269]16       REAL xo(nmax+1)
[259]17       LOGICAL decrois
18       INTEGER jmods
19
20c    .... Variables  locales  ....
21
[269]22       REAL xscr(nmax)
23       INTEGER i
[259]24       REAL pi, degres, chmin, chmax,mult
25c
26       DO i = 1, nmax
27        xo(i) = xi(i)
28       ENDDO
29
30       mult = 1.
31       IF( xo(1).GT.xo(nmax) )  mult = - 1.
32       IF( nmax.EQ.jjm    ) jmods = nmax +1
33       IF( nmax.EQ.jjm +1 ) jmods = nmax -1
34     
35       pi     = 2.*ASIN(1.)
36       degres = 180./pi
37       decrois = .FALSE.
38
39       CALL minmax(nmax,xo(1),chmin,chmax)
40
41       IF(chmax.LT.6.5 )  THEN
42          DO i = 1,nmax
43           xo(i) = xo(i) * degres
44          ENDDO
45       ENDIF
46
47       IF( nmax.EQ.jjm )   THEN
48         IF( xo(1).GT.xo(nmax) )   THEN
49           DO i = 1, nmax
50            xscr(i) = xo(i)
51           ENDDO
52           DO i = 1, nmax
53            xo(i+1) = xscr(i)
54           ENDDO
55            xo (   1    ) =   90.
56         ELSE
57            xo ( nmax+1 ) =   90.
58         ENDIF
59       ELSE
60          IF( nmax.NE.jjm +1 )   THEN
61             PRINT *,'  Dans la routine ord_coordm , l argument nmax '
62             PRINT *,'  n est pas egal a jjm ni a jjm +1 . Corriger !'
63             CALL ABORT
64          ELSE
65            IF( ABS( xo(1)+ mult * 90.).GT.0.01 )  THEN
66              PRINT *,' Avec nmax =',nmax,'on devrait avoir des',
67     ,    ' ordonnees = 90. deg pour j=1 ou jjm+1 ! '
68             CALL ABORT
69            ELSE
70               IF( xo(1).LT.xo(nmax) )  THEN
71                 DO i = 1, nmax
72                  xscr(i) = xo(i)
73                 ENDDO
74                 DO i = 1, nmax -1
75                  xo(i) = xscr(i+1)
76                 ENDDO
77               ENDIF
78            ENDIF
79          ENDIF
80       ENDIF
81
82       IF ( xo(2).LT.xo(1) ) decrois =.TRUE.
83
84       DO i = 3, nmax
85
86        IF(decrois.AND.xo(i).GT.xo(i-1) ) THEN
87         PRINT 1
88         CALL ABORT
89        ENDIF
90        IF(.NOT.decrois.AND.xo(i).LT.xo(i-1) ) THEN
91         PRINT 1
92         CALL ABORT
93        ENDIF
94
95       ENDDO
96       
97       IF( decrois )  THEN
98         CALL sort(jmods,xo(1))
99       ENDIF
100
101
1021      FORMAT(5x,' Incoherence dans les valeurs des latitudes de la ',
103     ,  'grille du modele ')
1042      FORMAT(1x,8f8.2)
105
106       RETURN
107       END
Note: See TracBrowser for help on using the repository browser.