1 | PROGRAM 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 | |
---|
153 | END PROGRAM generate_sections |
---|