source: branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readsections.f90 @ 2858

Last change on this file since 2858 was 2849, checked in by cbricaud, 9 years ago

tools to compute sections pathway

  • Property svn:executable set to *
File size: 8.6 KB
Line 
1MODULE readsections 
2   !!=====================================================================
3   !!                       ***  MODULE  readsections  ***
4   !!
5   !! History: 2011: cbricaud Mercator-Ocean
6   !!
7   !!=====================================================================
8   !! * Modules used
9   USE declarations   
10   USE sections_tools
11 
12   IMPLICIT NONE
13   PRIVATE
14
15   !! * Routine accessibility
16   PUBLIC read_list_sections 
17 
18CONTAINS
19
20  SUBROUTINE read_list_sections
21     !!---------------------------------------------------------------------
22     !!         ***  ROUTINE read_list_sections ***
23     !!
24     !! ** Purpose
25     !!
26     !! ** Method
27     !!
28     !! ** Input
29     !!
30     !! ** Action
31     !!
32     !! History
33     !!---------------------------------------------------------------------
34     !! * arguments
35
36     !! * Local declarations
37     INTEGER             :: jsec !loop on sections number
38     INTEGER             :: iost,ji
39     INTEGER             :: iclass , jclass
40     LOGICAL             :: llok,llstrpond,llice,lldate
41     REAL(wp)            :: plon1,plat1,plon2,plat2
42     REAL(wp)            :: zslope
43     CHARACTER(len=5)    :: clclass
44     CHARACTER(len=5)    :: cdice
45     CHARACTER(len=9)    :: cdstrpond
46     CHARACTER(len=110)  :: clname,cdsecname,cltmp
47     REAL,DIMENSION(nb_type_class):: zclass_value
48     TYPE(COORD_SECTION) :: coord_point1,coord_point2,coordTemp
49     TYPE(COORD_SECTION), DIMENSION(2)::coord_sec
50     !!---------------------------------------------------------------------
51     PRINT*,'              '
52     PRINT*,'READ list_sections'
53     PRINT*,'------------------'
54     PRINT*,'               '
55
56     nb_sec=0 !initialize numer of sections read in list_sections.ascii
57
58     !open and read input file
59     clname='list_sections.ascii'
60     PRINT*,'               '
61     CALL file_open(numdctin,clname,llok,cdform="FORMATTED",cdstatus="OLD",cdaction="READ")
62
63     IF ( llok ) THEN
64          PRINT*,'list_sections.ascii open '
65           PRINT*,'nb_sec_max = ',nb_sec_max
66          PRINT*,'                         '
67     
68          DO jsec=1,nb_sec_max
69
70                 !read a line corresponding to one section
71                 READ(numdctin,'(F7.2,1X,F7.2,1X,F7.2,1X,F7.2,1X,I2,1X,A9,1X,A5,1X,A40)',iostat=iost) & 
72                 &    plon1,plat1,plon2,plat2,iclass,cdstrpond,cdice,cdsecname
73                 IF (iost /= 0) EXIT  ! end of file
74
75                 ! cdsecname: change space to underscore for cdsecname
76                 cdsecname=ADJUSTL(cdsecname)
77                 ji = SCAN(TRIM(cdsecname)," ")
78                 DO WHILE(ji .NE. 0)
79                    cdsecname(ji:ji) = "_"
80                    ji = SCAN(TRIM(cdsecname)," ")
81                 ENDDO
82
83                 !computation of salinity and temperature balanced by the transport ?
84                 llstrpond=.FALSE. ; IF( cdstrpond .EQ. 'okstrpond' ) llstrpond=.TRUE.
85
86                 !computation of ice tranpsort ?
87                 llice=.FALSE. ; IF( cdice .EQ. 'okice' ) llice=.TRUE.
88
89                 !store extremities coordinates
90                 coord_point1=COORD_SECTION(plon1,plat1)
91                 coord_point2=COORD_SECTION(plon2,plat2)
92                 coord_sec=(/coord_point1,coord_point2/)
93
94                 !Extremities of the sec are classed
95                 lldate=.FALSE.
96                 IF(  coord_sec(2)%lon .LT. coord_sec(1)%lon  .OR.   &
97                    ((coord_sec(2)%lon .EQ. coord_sec(1)%lon) .AND.  &
98                     (coord_sec(2)%lat .LT. coord_sec(1)%lat)) ) THEN
99                      coordTemp   =coord_sec(1)
100                      coord_sec(1)=coord_sec(2)
101                      coord_sec(2)=coordTemp
102                 ENDIF
103                 IF((coord_sec(2)%lon - coord_sec(1)%lon) .GT. 180) THEN
104                      coordTemp   =coord_sec(1)
105                      coord_sec(1)=coord_sec(2)
106                      coord_sec(2)=coordTemp
107                      lldate=.TRUE.
108                 ENDIF
109
110                 !slope of the sec (equidistant cylindric projection)
111                 zslope=slope_coeff(coord_sec(1),coord_sec(2),lldate)
112
113                 !!init global array secs
114                 secs(jsec)%llstrpond=.FALSE. 
115                 secs(jsec)%ll_date_line=.FALSE. ; secs(jsec)%nb_class=0
116                 secs(jsec)%zsigi=99.            ; secs(jsec)%zsigp=99.
117                 secs(jsec)%zsal=99.             ; secs(jsec)%ztem=99.
118                 secs(jsec)%zlay=99.
119                 secs(jsec)%nb_point=0
120
121                 !store all informations in global array secs
122                 secs(jsec)%name           = cdsecname
123                 secs(jsec)%llstrpond      = llstrpond
124                 secs(jsec)%ll_ice_section = llice
125                 secs(jsec)%coordSec       = (/ coord_sec(1) , coord_sec(2) /)
126                 secs(jsec)%slopeSection   = zslope
127                 secs(jsec)%ll_date_line   = lldate
128
129                 !debug informations
130                 CALL write_debug(jsec,'Informations read in ascii file:')
131                 CALL write_debug(jsec,'--------------------------------')
132                 CALL write_debug(jsec,'section name: '//secs(jsec)%name )
133                 IF( secs(jsec)%llstrpond )THEN ; CALL write_debug(jsec,'salt/heat transport computing' )
134                 ELSE                           ; CALL write_debug(jsec,'no salt/heat transport computing' )
135                 ENDIF
136                 IF( secs(jsec)%ll_ice_section )THEN ; CALL write_debug(jsec,'Ice transport computing' )
137                 ELSE                                ; CALL write_debug(jsec,'no Ice transport computing' )
138                 ENDIF
139                 WRITE(cltmp,'(A20,2f8.3)')'Extremity 1 :',secs(jsec)%coordSec(1)
140                 CALL write_debug(jsec,cltmp)
141                 WRITE(cltmp,'(A20,2f8.3)')'Extremity 2 :',secs(jsec)%coordSec(2)
142                 CALL write_debug(jsec,cltmp)
143                 WRITE(cltmp,'(A20,f8.3)')'Slope coefficient :',secs(jsec)%slopeSection
144                 CALL write_debug(jsec,cltmp)
145                 WRITE(cltmp,'(A20,i3.3)')'number of classes : ',iclass
146                 CALL write_debug(jsec,cltmp)
147                 IF( secs(jsec)%ll_date_line ) THEN ;  CALL write_debug(jsec,'section crosses date line')
148                 ELSE                                ; CALL write_debug(jsec,'section don t crosse date line')
149                 ENDIF
150                 CALL write_debug(jsec,'                        ')
151
152                 !verify number of sections and store it
153                 IF ( iclass .GT. nb_class_max) THEN
154                     PRINT*,"WARNING:  nb_class_max needs to be greater than ", iclass ; STOP
155                 ENDIF
156                 secs(jsec)%nb_class=iclass
157
158                 !read classes
159                 IF ( iclass .NE. 0 )THEN
160
161                      !classname=zsigi/zsigp/zsal/ztem/zlay
162                      READ(numdctin,'(A5)')clclass
163                      DO jclass = 1,iclass
164                         READ(numdctin,'(F9.3)',iostat=iost) zclass_value(jclass) 
165                      ENDDO 
166                      IF      ( TRIM(clclass) .EQ. 'zsigi' )THEN
167                           secs(jsec)%zsigi(1:iclass)=zclass_value(1:iclass) 
168                      ELSE IF ( TRIM(clclass) .EQ. 'zsigp' )THEN
169                           secs(jsec)%zsigp(1:iclass)=zclass_value(1:iclass) 
170                      ELSE IF ( TRIM(clclass) .EQ. 'zsal'  )THEN
171                           secs(jsec)%zsal(1:iclass)=zclass_value(1:iclass) 
172                      ELSE IF ( TRIM(clclass) .EQ. 'ztem'  )THEN
173                           secs(jsec)%ztem(1:iclass)=zclass_value(1:iclass)
174                      ELSE IF ( TRIM(clclass) .EQ. 'zlay'  )THEN
175                           secs(jsec)%zlay(1:iclass)=zclass_value(1:iclass)
176                      ELSE
177                          PRINT*,'Wrong name of class for section/clclass: ', cdsecname,TRIM(clclass)
178                      ENDIF
179
180                      IF ( jsec==nsecdebug .OR. nsecdebug==-1)THEN
181                           PRINT*,'class type = ',clclass
182                           PRINT*,'class values = ',zclass_value(1:iclass)
183                      ENDIF
184
185                 ENDIF
186
187          ENDDO !end of loop on sections
188         
189          CLOSE(numdctin) !Close file
190          IF( jsec .EQ. nb_sec_max)THEN
191              PRINT*,'   '
192              PRINT*,' nb_sec_max is less than the number of sections written in list_sections.ascii'
193              STOP
194          ELSE
195             nb_sec=jsec-1 !number of read sections
196             PRINT*,'   '
197             PRINT*,'Number of sections read in list_sections.ascii: ',nb_sec 
198             PRINT*,'Reading of list_sections.ascii ok'
199             PRINT*,'   '
200          ENDIF
201
202     ENDIF
203
204  END SUBROUTINE  read_list_sections
205
206END MODULE readsections 
Note: See TracBrowser for help on using the repository browser.