[2849] | 1 | MODULE writesections |
---|
| 2 | !!===================================================================== |
---|
| 3 | !! *** MODULE writesections *** |
---|
| 4 | !! |
---|
[2878] | 5 | !! History: 2011: Clement Bricaud, Mercator-Ocean |
---|
[2849] | 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 ! |
---|
[2947] | 43 | TYPE(POINT_SECTION) :: point !coordinates of a point |
---|
[2849] | 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 |
---|
[2858] | 78 | i1 = secs(jsec)%listPoint(jseg)%I ; i2 = secs(jsec)%listPoint(jseg)%J |
---|
[2849] | 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 |
---|