source: CPL/oasis3/trunk/src/mod/oasis3/src/locwrith.f @ 1677

Last change on this file since 1677 was 1677, checked in by aclsce, 12 years ago

Imported oasis3 (tag ipslcm5a) from cvs server to svn server (igcmg project).

File size: 3.2 KB
Line 
1      SUBROUTINE locwrith (cdfldn, cdjob, ktime, pfield, 
2     $                     kdimax, knulre, kflgre)
3C****
4C               *****************************
5C               * OASIS ROUTINE  -  LEVEL 0 *
6C               * -------------     ------- *
7C               *****************************
8C
9C**** *locwrith*  - Write binary field and header on unit knulre
10C
11C     Purpose:
12C     -------
13C     Write string cdfldn, header and array pfield on unit knulre
14C
15C**   Interface:
16C     ---------
17C       *CALL*  *locwrith (cdfldn, pfield, cdjob, ktime,
18C                          kdimax, knulre, kflgre)*
19C
20C     Input:
21C     -----
22C                cdfldn : character string locator
23C                cdjob  : experiment name
24C                ktime  : header array (integer 1D)
25C                kdimax : dimension of field to be written 
26C                knulre : logical unit to be written
27C                pfield : field array (real 1D) 
28C
29C     Output:
30C     ------
31C                kflgre : error status flag
32C
33C     Workspace:
34C     ---------
35C     None
36C
37C     Externals:
38C     ---------
39C     None
40C
41C     Reference:
42C     ---------
43C     See OASIS manual (1997) 
44C
45C     History:
46C     -------
47C       Version   Programmer     Date      Description
48C       -------   ----------     ----      ----------- 
49C       2.2       L. Terray      97/12/14  created
50C       2.3       S. Valcke      99/04/30  added: printing levels
51C
52C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
53C
54C* ---------------------------- Include files ---------------------------
55C
56      USE mod_kinds_oasis
57      USE mod_unit
58      USE mod_printing
59C
60C* ---------------------------- Argument declarations -------------------
61C
62      REAL (kind=ip_realwp_p) pfield(kdimax)
63      INTEGER (kind=ip_intwp_p) ktime(3)
64      CHARACTER*8 cdfldn
65      CHARACTER*3 cdjob
66C
67C* ---------------------------- Poema verses ----------------------------
68C
69C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
70C
71C*    1. Initialization
72C        --------------
73C
74      IF (nlogprt .GE. 2) THEN
75          WRITE (UNIT = nulou,FMT = *) ' '
76          WRITE (UNIT = nulou,FMT = *) ' '
77          WRITE (UNIT = nulou,FMT = *) 
78     $    '           ROUTINE locwrith  -  Level 0'
79          WRITE (UNIT = nulou,FMT = *) 
80     $    '           ****************     *******'
81          WRITE (UNIT = nulou,FMT = *) ' '
82          WRITE (UNIT = nulou,FMT = 1001) knulre
83          WRITE (UNIT = nulou,FMT = *) ' '
84      ENDIF
85C
86C* Formats
87C
88 1001 FORMAT(5X,' Write binary file connected to unit = ',I3)
89C
90C     2. Write header and field to file
91C        ------------------------------
92C
93C* Write string and header
94      WRITE (UNIT = knulre, ERR = 210) cdfldn, cdjob, ktime
95C* Write associated field
96      WRITE (UNIT = knulre, ERR = 210) pfield
97C* Writing done and ok
98      kflgre = 0
99      GO TO 220
100C* Problem in Writing
101 210  kflgre = 1
102 220  CONTINUE
103C
104C
105C*    3. End of routine
106C        --------------
107C
108      IF (nlogprt .GE. 2) THEN
109          WRITE (UNIT = nulou,FMT = *) 
110     $    '          --------- End of routine locwrith ---------'
111          WRITE (UNIT = nulou,FMT = *) ' '
112          CALL FLUSH (nulou)
113      ENDIF
114      RETURN
115      END
116
117
Note: See TracBrowser for help on using the repository browser.