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.
writesections.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/writesections.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.0 KB
Line 
1MODULE writesections 
2   !!=====================================================================
3   !!                       ***  MODULE  writesections  ***
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  write_sections 
17   PRIVATE file_open 
18 
19CONTAINS
20
21  SUBROUTINE write_sections
22     !!---------------------------------------------------------------------
23     !!         ***  ROUTINE read_list_sections ***
24     !!
25     !! ** Purpose
26     !!
27     !! ** Method
28     !!
29     !! ** Input
30     !!
31     !! ** Action
32     !!
33     !! History
34     !!---------------------------------------------------------------------
35     !! * arguments
36
37     !! * Local declarations
38     INTEGER             :: jsec ,&!loop on sections
39                            jseg   !loop on segments
40     INTEGER             :: i1, i2 !temporary integers
41     LOGICAL             :: llok   !
42     CHARACTER(len=40)   :: clname !
43     TYPE(POINT_SECTION) :: point  !a point's coordinates
44
45     !!---------------------------------------------------------------------
46
47     PRINT*,'              '
48     PRINT*,'WRITE SECTIONS'
49     PRINT*,'--------------'
50
51     !open output file
52     llok=.FALSE.
53     clname='section_ijglobal.diadct'
54     !CALL file_open(numdctout,clname,llok)
55     CALL file_open(numdctout,clname,llok,cdform="UNFORMATTED",cdstatus="REPLACE",cdaction="WRITE")
56
57     !print informations
58     IF ( llok ) THEN
59          PRINT*,TRIM(clname),' open. '
60
61          DO jsec=1,nb_sec
62 
63             WRITE(numdctout)jsec
64             WRITE(numdctout)secs(jsec)%name
65             WRITE(numdctout)secs(jsec)%llstrpond
66             WRITE(numdctout)secs(jsec)%ll_ice_section
67             WRITE(numdctout)secs(jsec)%ll_date_line
68             WRITE(numdctout)secs(jsec)%coordSec
69             WRITE(numdctout)secs(jsec)%nb_class
70             WRITE(numdctout)secs(jsec)%zsigi
71             WRITE(numdctout)secs(jsec)%zsigp
72             WRITE(numdctout)secs(jsec)%zsal
73             WRITE(numdctout)secs(jsec)%ztem
74             WRITE(numdctout)secs(jsec)%zlay
75             WRITE(numdctout)secs(jsec)%slopeSection
76             WRITE(numdctout)secs(jsec)%nb_point
77             IF( secs(jsec)%nb_point .NE. 0 )THEN
78                DO jseg=1,secs(jsec)%nb_point
79                   point=POINT_SECTION( mig(secs(jsec)%listPoint(jseg)%I) , mjg(secs(jsec)%listPoint(jseg)%J) )
80                   i1 = mig(secs(jsec)%listPoint(jseg)%I) ; i2 = mjg(secs(jsec)%listPoint(jseg)%J)
81                   !WRITE(numdctout)point
82                   WRITE(numdctout)i1,i2
83                ENDDO
84                WRITE(numdctout)secs(jsec)%direction(1:secs(jsec)%nb_point)
85             ENDIF
86
87
88             !---------------------
89             !WRITE(500,*)jsec
90             !WRITE(500,*)secs(jsec)%name
91             !WRITE(500,*)secs(jsec)%llstrpond
92             !WRITE(500,*)secs(jsec)%ll_ice_section
93             !WRITE(500,*)secs(jsec)%ll_date_line
94             !WRITE(500,*)secs(jsec)%coordSec
95             !WRITE(500,*)secs(jsec)%nb_class
96             !WRITE(500,*)secs(jsec)%zsigi
97             !WRITE(500,*)secs(jsec)%zsigp
98             !WRITE(500,*)secs(jsec)%zsal
99             !WRITE(500,*)secs(jsec)%ztem
100             !WRITE(500,*)secs(jsec)%zlay
101             !WRITE(500,*)secs(jsec)%slopeSection
102             !WRITE(500,*)secs(jsec)%nb_point
103             !IF( secs(jsec)%nb_point .NE. 0 )THEN
104             !   DO jseg=1,secs(jsec)%nb_point
105             !      point=POINT_SECTION( mig(secs(jsec)%listPoint(jseg)%I) , mjg(secs(jsec)%listPoint(jseg)%J) )
106             !      WRITE(500,*)point
107             !   ENDDO
108             !   WRITE(500,*)secs(jsec)%direction(1:secs(jsec)%nb_point)
109             !ENDIF
110
111             !---------------------
112          ENDDO !end of loop on sections
113         
114          CLOSE(numdctout) !Close file
115     ENDIF
116
117  END SUBROUTINE  write_sections
118
119END MODULE writesections 
Note: See TracBrowser for help on using the repository browser.