New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
readsections.f90 in branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT/src – NEMO

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

Last change on this file since 2877 was 2877, checked in by cbricaud, 13 years ago

coding rules

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