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 @ 2858

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

cleanning, minor modifications

  • Property svn:executable set to *
File size: 2.8 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,cdform="UNFORMATTED",cdstatus="REPLACE",cdaction="WRITE")
55
56     !print informations
57     IF ( llok ) THEN
58          PRINT*,TRIM(clname),' open. '
59
60          DO jsec=1,nb_sec
61 
62             WRITE(numdctout)jsec
63             WRITE(numdctout)secs(jsec)%name
64             WRITE(numdctout)secs(jsec)%llstrpond
65             WRITE(numdctout)secs(jsec)%ll_ice_section
66             WRITE(numdctout)secs(jsec)%ll_date_line
67             WRITE(numdctout)secs(jsec)%coordSec
68             WRITE(numdctout)secs(jsec)%nb_class
69             WRITE(numdctout)secs(jsec)%zsigi
70             WRITE(numdctout)secs(jsec)%zsigp
71             WRITE(numdctout)secs(jsec)%zsal
72             WRITE(numdctout)secs(jsec)%ztem
73             WRITE(numdctout)secs(jsec)%zlay
74             WRITE(numdctout)secs(jsec)%slopeSection
75             WRITE(numdctout)secs(jsec)%nb_point
76             IF( secs(jsec)%nb_point .NE. 0 )THEN
77                DO jseg=1,secs(jsec)%nb_point
78                   i1 = secs(jsec)%listPoint(jseg)%I  ; i2 = secs(jsec)%listPoint(jseg)%J
79                   WRITE(numdctout)i1,i2
80                ENDDO
81                WRITE(numdctout)secs(jsec)%direction(1:secs(jsec)%nb_point)
82             ENDIF
83
84          ENDDO !end of loop on sections
85         
86          CLOSE(numdctout) !Close file
87     ENDIF
88
89  END SUBROUTINE  write_sections
90
91END MODULE writesections 
Note: See TracBrowser for help on using the repository browser.