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/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/TOOLS/SECTIONS_DIADCT/src – NEMO

source: branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/diadct_sections.f90 @ 5985

Last change on this file since 5985 was 5985, checked in by timgraham, 8 years ago

Reinstate keywords before upgrading to head of trunk

  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 3.7 KB
Line 
1PROGRAM generate_sections
2     !!==============================================================================
3     !!                       ***  PROGRAM generate_sections    ***
4     !!
5     !! create a binary file containig the IJ positions of sections in global
6     !! coordinates for the diagnostic routine diadct.F90 of NEMO
7     !!
8     !!
9     !! History: 09/2011: Clement Bricaud ( 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 segments (parts of the section)
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     !1. Read namelist   !
39     !-------------------!
40     PRINT*,'              '
41     PRINT*,'READ NAMELIST'
42     PRINT*,'--------------'
43
44     !!open, read and close namelist
45     nsecdebug=0
46     clname='namelist'
47     CALL file_open(numnam,clname,llok,cdform="FORMATTED",cdstatus="OLD",cdaction="READ")
48     IF ( llok ) THEN
49          REWIND( numnam )
50          READ  ( numnam, namdct )
51          PRINT*,'  '
52          PRINT*,'read namelist'
53          IF( nsecdebug==-1      )THEN ; PRINT*,' Debug all sections'
54          ELSE IF ( nsecdebug==0 )THEN ; PRINT*,' No section to debug'
55          ELSE IF ( nsecdebug .GE. 1 .AND. nsecdebug .LE. nb_sec_max )THEN
56              PRINT*,' Debug section number ',nsecdebug
57          ELSE
58              PRINT*,'Wrong number for nsecdebug = ',nsecdebug
59          ENDIF
60     ENDIF
61     CLOSE(numnam)
62     PRINT*,'read namelist ok'
63
64     !-------------------------------------!
65     !2. Read coordinates and meshmask     !
66     !-------------------------------------!
67     CALL read_coord_mesh
68 
69     PRINT*,'domain sizes: '
70     PRINT*,'jpi    jpj    = ',jpi   ,jpj 
71     PRINT*,'domain boundaries: '
72     PRINT*,' 1   1   ',glamt(1,1),gphit(1,1)
73     PRINT*,' 1   jpj ',glamt(1,jpj),gphit(1,jpj)
74     PRINT*,' jpi 1   ',glamt(jpi,1),gphit(jpi,1)
75     PRINT*,'jpi jpj  ',glamt(jpi,jpj),gphit(jpi,jpj)
76
77
78
79     !----------------------!
80     !3. Read list_sections !
81     !----------------------!
82     num_sec_debug(:)=0     ! Unit numbers for debug files
83     CALL read_list_sections
84
85     !----------------------!
86     !4.Compute sections    !
87     !----------------------!
88     DO jsec=1,nb_sec
89          !we use compsec to generate the series of grid points making the section
90          IF(jsec == nsecdebug .OR. nsecdebug ==-1)THEN
91             CALL compsec(jsec,secs(jsec),.true.)
92          ELSE
93             CALL compsec(jsec,secs(jsec),.false.)
94          ENDIF
95          IF (jsec == nb_sec)PRINT*,'compute section ok '
96     ENDDO
97
98     !--------------------------------!
99     !5.Write section_ijglobal.diadct !
100     !--------------------------------!
101     CALL write_sections
102
103     !----------------------!
104     !END                   !
105     !----------------------!
106   
107     !close debug files
108     DO jsec=1,nb_sec
109        IF( num_sec_debug(jsec) .NE. 0 )CLOSE(num_sec_debug(jsec))
110     ENDDO
111
112     PRINT*,'END END END END END END END END END END END END'
113
114END PROGRAM generate_sections
Note: See TracBrowser for help on using the repository browser.