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.
diadct_sections.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/diadct_sections.f90 @ 2849

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

tools to compute sections pathway

  • Property svn:executable set to *
File size: 4.8 KB
Line 
1PROGRAM generate_sections
2     !!==============================================================================
3     !!                       ***  PROGRAM generate_sections    ***
4     !! create a binary file containig the IJ positions of sections in global
5     !! coordinates for the diagnostic routine diadct.F90 of NEMO
6     !!
7     !!
8     !!
9     !! History: 2011: cbricaud Mercator-Ocean
10     !!
11     !!==============================================================================
12     !! * Modules used
13     USE declarations
14     USE sections_tools
15     USE readcoordmesh 
16     USE readsections
17     USE compute_sections
18     USE writesections   
19
20     IMPLICIT NONE
21 
22     !! * Module Variables used
23     INTEGER            :: iargc, narg
24     CHARACTER(LEN=80)  :: cdum
25     INTEGER            :: jsec ,&! loop on sections
26                           jseg   ! loop on sections' points
27     CHARACTER(len=40)  :: clname
28     LOGICAL            :: llok
29
30     NAMELIST/namdct/nsecdebug
31     !!==============================================================================     
32 
33     PRINT*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
34     PRINT*,'CREATION OF SECTIONS FOR NEMO diadct.F90 ROUTINE'
35     PRINT*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
36 
37     !----------------------!
38     !0. Read arguments     !
39     !----------------------!
40     PRINT*,'              '
41     PRINT*,'READ ARGUMENTS'
42     PRINT*,'--------------'
43 
44     !check number of arguments and display usage message if wrong
45     narg=iargc()
46     PRINT*,'narg= ',narg
47     IF ( narg /= 4 ) THEN
48          PRINT *,' Usage : generate_sections jpidta jpjdta jpizoom jpjzoom '
49          STOP
50     ENDIF
51
52     ! read on line arguments
53     CALL getarg(1,cdum) ; READ(cdum,*) jpidta
54     CALL getarg(2,cdum) ; READ(cdum,*) jpjdta
55     CALL getarg(3,cdum) ; READ(cdum,*) jpizoom 
56     CALL getarg(4,cdum) ; READ(cdum,*) jpjzoom
57 
58     PRINT*,'jpidta  jpjdta =',jpidta,jpjdta
59     PRINT*,'jpizoom jpjzoom=',jpizoom,jpjzoom
60 
61     !------------------!
62     !0. INITIALISATION !     
63     !------------------!     
64     PRINT*,'              '
65     PRINT*,'DOMAIN SIZE'
66     PRINT*,'--------------'
67
68     !Domain size
69     jpiglo = jpidta-jpizoom+1  ; jpjglo = jpjdta-jpjzoom+1
70     jpi    = jpiglo            ; jpj    = jpjglo
71     nlci   = jpiglo            ; nlcj   = jpjglo 
72     nlei   = jpiglo            ; nlej   = jpjglo
73
74     PRINT*,'jpiglo jpjglo = ',jpiglo,jpjglo
75     PRINT*,'jpi    jpj    = ',jpi   ,jpj 
76     PRINT*,'nlci  nlcj    = ',nlci,nlcj
77 
78     !-------------------!
79     !1. Read namelist   !
80     !-------------------!
81     PRINT*,'              '
82     PRINT*,'READ NAMELIST'
83     PRINT*,'--------------'
84
85     !!open, read and close namelist
86     nsecdebug=0
87     clname='namelist'
88     CALL file_open(numnam,clname,llok,cdform="FORMATTED",cdstatus="OLD",cdaction="READ")
89     IF ( llok ) THEN
90          REWIND( numnam )
91          READ  ( numnam, namdct )
92          PRINT*,'  '
93          PRINT*,'read namelist'
94          IF( nsecdebug==-1      )THEN ; PRINT*,' Debug all sections'
95          ELSE IF ( nsecdebug==0 )THEN ; PRINT*,' No section to debug'
96          ELSE IF ( nsecdebug .GE. 1 .AND. nsecdebug .LE. nb_sec_max )THEN
97              PRINT*,' Debug section number ',nsecdebug
98          ELSE
99              PRINT*,'Wrong number for nsecdebug = ',nsecdebug
100          ENDIF
101     ENDIF
102     CLOSE(numnam)
103     PRINT*,'read namelist ok'
104
105     !-------------------------------------!
106     !2. Read coordinates and meshmask     !
107     !-------------------------------------!
108     CALL read_coord_mesh
109 
110     PRINT*,'domain boundaries: '
111     PRINT*,' 1   1   ',glamt(1,1),gphit(1,1)
112     PRINT*,' 1   jpj ',glamt(1,jpj),gphit(1,jpj)
113     PRINT*,' jpi 1   ',glamt(jpi,1),gphit(jpi,1)
114     PRINT*,'jpi jpj  ',glamt(jpi,jpj),gphit(jpi,jpj)
115
116
117
118     !----------------------!
119     !3. Read list_sections !
120     !----------------------!
121     num_sec_debug(:)=0     ! Unit numbers for debug files
122     CALL read_list_sections
123
124     !----------------------!
125     !4.Compute sections    !
126     !----------------------!
127     DO jsec=1,nb_sec
128          !we use compsec to generate the serie of grid points making the section
129          IF(jsec == nsecdebug .OR. nsecdebug ==-1)THEN
130             CALL compsec(jsec,secs(jsec),.true.)
131          ELSE
132             CALL compsec(jsec,secs(jsec),.false.)
133          ENDIF
134          IF (jsec == nb_sec)PRINT*,'compute section ok '
135     ENDDO
136
137     !----------------------!
138     !5.ecriture du fichier !
139     !----------------------!
140     CALL write_sections
141
142     !----------------------!
143     !END                   !
144     !----------------------!
145   
146     !close debug files
147     DO jsec=1,nb_sec
148        IF( num_sec_debug(jsec) .NE. 0 )CLOSE(num_sec_debug(jsec))
149     ENDDO
150
151     PRINT*,'END END END END END END END END END END END END'
152
153END PROGRAM generate_sections
Note: See TracBrowser for help on using the repository browser.