1 | MODULE writesections |
---|
2 | !!===================================================================== |
---|
3 | !! *** MODULE writesections *** |
---|
4 | !! |
---|
5 | !! History: 2011: Clement Bricaud, 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 | |
---|
19 | CONTAINS |
---|
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 !coordinates of a point |
---|
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 | |
---|
91 | END MODULE writesections |
---|