/[MITgcm]/MITgcm/pkg/mdsio/mdsio_pass_r4tors.F
ViewVC logotype

Annotation of /MITgcm/pkg/mdsio/mdsio_pass_r4tors.F

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

Revision 1.3 - (hide annotations) (download)
Mon Jun 8 03:32:33 2009 UTC (14 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62p, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.2: +33 -19 lines 
 - do tiled IO in 1 piece (all levels at a time)
 - multi-threaded: allow to read/write local (non-shared) array
   (was already working with singleCpuIO ; now works also without);
 - move barrier calls outside gather/scatter_2d to mds_read/write field
1 jmc 1.3 C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_pass_r4tors.F,v 1.2 2009/06/01 14:20:31 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "MDSIO_OPTIONS.h"
5    
6     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7     C- modification: no need to edit the 4 scr files mdsio_pass_r{4,8}tor{l,s}.F :
8     C from the 1rst src file (mdsio_pass_r4torl.F), can update the 3 others
9     C using the script "derive_other_types".
10     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
11    
12     CBOP
13     C !ROUTINE: MDS_PASS_R4toRS
14     C !INTERFACE:
15 jmc 1.3 SUBROUTINE MDS_PASS_R4toRS( buffer, arrFld, nNz, kLo, kSize,
16 jmc 1.2 I biArg, bjArg, copyTo, myThid )
17 jmc 1.1
18     C !DESCRIPTION:
19 jmc 1.3 C Transfert 3-D real*4 buffer to 3-D RS model array, or the reverse,
20 jmc 1.2 C depending on "copyTo" value. Apply transfert to tile biArg,bjArg
21     C only or to all myThid tiles if called with biArg=bjArg=0.
22 jmc 1.1
23     C !USES:
24     IMPLICIT NONE
25    
26     C Global variables / common blocks
27     #include "EEPARAMS.h"
28     #include "SIZE.h"
29    
30     C !INPUT/OUTPUT PARAMETERS:
31     C Routine arguments
32 jmc 1.3 C buffer (real*4) :: buffer 3-D array (Input/Output if copyTo=T/F)
33     C arrFld ( RS ) :: model 3-D tiled array (Output/Input if copyTo=T/F)
34     C nNz (integer):: Number of levels to - fill in / extract from - arrFld
35     C kLo (integer):: 1rst level to - fill in / extract from - arrFld
36     C kSize (integer):: third dimension of 3-D array "arrFld"
37     C biArg (integer):: tile X-index to - fill in / extract from - tiled buffer
38     C bjArg (integer):: tile Y-index to - fill in / extract from - tiled buffer
39 jmc 1.1 C copyTo (logical):: if =T, copy 2-D -> 3-D ; if =F: copy 2-D <- 3-D
40     C myThid (integer):: my Thread Id number
41 jmc 1.3 INTEGER nNz, kSize
42     Real*4 buffer(1:sNx,1:sNy,nNz,nSx,nSy)
43     _RS arrFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
44     INTEGER kLo
45 jmc 1.2 INTEGER biArg
46     INTEGER bjArg
47 jmc 1.1 LOGICAL copyTo
48     INTEGER myThid
49    
50     C !LOCAL VARIABLES:
51 jmc 1.3 C i,j,k :: loop indices
52 jmc 1.1 C bi,bj :: tile indices
53 jmc 1.3 INTEGER i,j,k,bi,bj
54     INTEGER kLev
55 jmc 1.1 CEOP
56    
57 jmc 1.2 IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
58     IF ( copyTo ) THEN
59     DO bj = myByLo(myThid), myByHi(myThid)
60     DO bi = myBxLo(myThid), myBxHi(myThid)
61 jmc 1.3 DO k=1,nNz
62     kLev = kLo+k-1
63 jmc 1.2 DO j=1,sNy
64     DO i=1,sNx
65 jmc 1.3 arrFld(i,j,kLev,bi,bj) = buffer(i,j,k,bi,bj)
66 jmc 1.2 ENDDO
67     ENDDO
68 jmc 1.3 ENDDO
69 jmc 1.2 ENDDO
70     ENDDO
71     ELSE
72     DO bj = myByLo(myThid), myByHi(myThid)
73     DO bi = myBxLo(myThid), myBxHi(myThid)
74 jmc 1.3 DO k=1,nNz
75     kLev = kLo+k-1
76 jmc 1.2 DO j=1,sNy
77     DO i=1,sNx
78 jmc 1.3 buffer(i,j,k,bi,bj) = arrFld(i,j,kLev,bi,bj)
79 jmc 1.2 ENDDO
80     ENDDO
81 jmc 1.3 ENDDO
82 jmc 1.2 ENDDO
83     ENDDO
84     ENDIF
85     ELSEIF ( biArg.GE.1 .AND. biArg.LE.nSx
86     & .AND. bjArg.GE.1 .AND. bjArg.LE.nSy ) THEN
87     bi = biArg
88     bj = bjArg
89     IF ( copyTo ) THEN
90 jmc 1.3 DO k=1,nNz
91     kLev = kLo+k-1
92 jmc 1.1 DO j=1,sNy
93     DO i=1,sNx
94 jmc 1.3 arrFld(i,j,kLev,1,1) = buffer(i,j,k,bi,bj)
95 jmc 1.1 ENDDO
96     ENDDO
97 jmc 1.3 ENDDO
98 jmc 1.2 ELSE
99 jmc 1.3 DO k=1,nNz
100     kLev = kLo+k-1
101 jmc 1.1 DO j=1,sNy
102     DO i=1,sNx
103 jmc 1.3 buffer(i,j,k,bi,bj) = arrFld(i,j,kLev,1,1)
104 jmc 1.1 ENDDO
105     ENDDO
106 jmc 1.3 ENDDO
107 jmc 1.2 ENDIF
108     ELSE
109     STOP 'ABNORMAL END: MDS_PASS_R4toRS invalid bi,bj Arg'
110 jmc 1.1 ENDIF
111    
112     RETURN
113     END
  ViewVC Help
Powered by ViewVC 1.1.22