/[MITgcm]/MITgcm/eesupp/src/write_field.F
ViewVC logotype

Contents of /MITgcm/eesupp/src/write_field.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.8 - (show annotations) (download)
Sun Feb 4 14:38:44 2001 UTC (23 years, 4 months ago) by cnh
Branch: MAIN
CVS Tags: checkpoint40pre3, checkpoint40pre2, checkpoint40pre1, checkpoint40pre7, checkpoint40pre6, checkpoint40pre5, checkpoint40pre4, pre38-close, checkpoint39, checkpoint38, checkpoint37, checkpoint36, checkpoint35, pre38tag1, c37_adj
Branch point for: pre38
Changes since 1.7: +2 -1 lines
Made sure each .F and .h file had
the CVS keywords Header and Name at its start.
Most had header but very few currently have Name, so
lots of changes!

1 C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/write_field.F,v 1.7 2000/03/15 16:00:52 adcroft Exp $
2 C $Name: $
3
4 #include "CPP_EEOPTIONS.h"
5
6 SUBROUTINE WRITE_FIELD_XYZR8(
7 O fld,
8 I filNam, filFmt, myThid )
9 C /==========================================================\
10 C | SUBROUTINE WRITE_FIELD_XYZR8 |
11 C | o Writes out a three-dimensional model array |
12 C |==========================================================|
13 C | Routine that controls the writing of external datasets |
14 C | into the model. In a multi-threaded and/or MPI world |
15 C | this can be a non-trivial exercise. Here we use the |
16 C | following approach: |
17 C | Thread 1. writes data for the process domain i.e. all |
18 C | threads into a buffer. This thread then writes out |
19 C | the data for process. |
20 C | By default output files are written split and have to be |
21 C | merged in a post-processing stage - YUK! |
22 C \==========================================================/
23 IMPLICIT NONE
24 C == GLobal variables ==
25 #include "SIZE.h"
26 #include "EEPARAMS.h"
27 #include "EESUPPORT.h"
28 #include "EEIO.h"
29
30 C == Routine arguments ==
31 C fld - Array into which data will be written.
32 C filNam - Name of file to read.
33 C filFmt - Format to use to read the file.
34 C myNz - No. vertical layers for array fld.
35 C myThid - Thread number for this instance of the routine.
36 _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx, nSy )
37 CHARACTER*(*) filNam
38 CHARACTER*(*) filFmt
39 INTEGER myThid
40
41 #ifdef USE_EEIO
42
43 C == Local variables ==
44 C msgBuf - Variable for writing error messages
45 C I,J,K, bi,bj - Loop counters
46 C dUnit - Unit number for file I/O
47 C ioStatus - I/O error code
48 CHARACTER*(MAX_LEN_MBUF) msgBuf
49 INTEGER I
50 INTEGER J
51 INTEGER K
52 INTEGER bi
53 INTEGER bj
54 INTEGER iG, jG
55 INTEGER dUnit
56 INTEGER ioStatus
57 C
58 dUnit = 42
59
60 C-- Open the file
61 C Note: The error trapping here is inelegant. There is no
62 C easy way to tell other threads and/or MPI processes that
63 C there was an error. Here we simply STOP if there is an error.
64 C Under a multi-threaded mode this will halt all the threads.
65 C Under MPI the other processes may die or they may just hang!
66 _BEGIN_MASTER(myThid)
67 OPEN(dUnit,FILE=filNam,FORM='unformatted',STATUS='old',
68 & IOSTAT=ioStatus)
69 IF ( ioStatus .GT. 0 ) THEN
70 WRITE(msgBuf,'(A)')
71 & 'S/R READ_FIELD_XYZR8'
72 CALL PRINT_ERROR( msgBuf , myThid)
73 WRITE(msgBuf,'(A)')
74 & 'Open for read failed for'
75 CALL PRINT_ERROR( msgBuf , myThid)
76 WRITE(msgBuf,'(A,A50)')
77 & 'file ',filNam
78 CALL PRINT_ERROR( msgBuf , myThid)
79 STOP 'ABNORMAL END: S/R READ_FIELD_XYZR8'
80 ENDIF
81 _END_MASTER(myThid)
82
83 DO K = 1, Nr
84 C-- Read data from file one XY layer at a time
85 _BEGIN_MASTER(myThid)
86 C READ ...
87 DO J=1,Ny
88 DO I=1,Nx
89 IF ( filNam(1:1) .EQ. 'u' ) THEN
90 IO_tmpXY_R8(I,J) = 0.0 _d 0
91 IF ( J .GT. 15 .AND. J .LT. 24 )
92 & IO_tmpXY_R8(I,J) = 0.1 _d 0
93 ELSEIF ( filNam(1:1) .EQ. 'v' ) THEN
94 IO_tmpXY_R8(I,J) = 0.0 _d 0
95 ELSE
96 IO_tmpXY_R8(I,J) = 0.0 _d 0
97 ENDIF
98 ENDDO
99 ENDDO
100 _END_MASTER(myThid)
101 _BARRIER
102 C-- Copy data into per thread data structures
103 DO bj=myByLo(myThid),myByHi(myThid)
104 DO bi=myBxLo(myThid),myBxHi(myThid)
105 DO j=1,sNy
106 DO i=1,sNx
107 iG = myXGlobalLo+(bi-1)*sNx+I-1
108 jG = myYGlobalLo+(bj-1)*sNy+J-1
109 fld(i,j,k,bi,bj) = IO_tmpXY_R8(iG,jG)
110 ENDDO
111 ENDDO
112 ENDDO
113 ENDDO
114 _BARRIER
115 ENDDO
116 C
117 _EXCH_XYZ_R8(fld, myThid )
118 C
119 #endif
120
121 RETURN
122 END

  ViewVC Help
Powered by ViewVC 1.1.22