SUBROUTINE O_SMARTPASS( 9ORH3F403.86
& IFIELDIN, IFIELDOUT, ORH3F403.87
& RFIELDIN, RFIELDOUT, ORH3F403.88
& ISIZEIN, ISIZEOUT, ORH3F403.89
& ISTART,TYPE) ORH3F403.90
ORH3F403.91
IMPLICIT NONE ORH3F403.92
! ORH3F403.93
! Description: ORH3F403.94
! This routine receives a real array which has been decomposed ORH3F403.95
! across several parallel processes and ensures that all processes ORH3F403.96
! receive an up to date version of the entire array. ORH3F403.97
! ORH3F403.98
! Current Code Owner: Richard Hill ORH3F403.99
! ORH3F403.100
! History: ORH3F403.101
! Model Date Modification history: ORH3F403.102
! version ORH3F403.103
! 4.1 24/04/96 New DECK created for the Parallel Unified ORH3F403.104
! Ocean Model. R.Hill ORH3F403.105
! 4.3 12/03/97 Tidy up communications and correct syntax ORH3F403.106
! of GC_BCASTS to allow shmem use and for ORH3F403.107
! efficiency. ORH3F403.108
! Subroutine Arguments: ORH3F403.109
ORH3F403.110
ORH3F403.111
*CALL PARVARS 
ORH3F403.112
*CALL COCNINDX ORH3F403.113
ORH3F403.114
INTEGER ISTART ! Start index of sub-array ORH3F403.115
&, ISIZEIN ! Size of sub array passed in ORH3F403.116
&, TYPE ! 1 = integer, 2 = REAL ORH3F403.117
&, I ORH3F403.118
ORH3F403.119
ORH3F403.120
INTEGER ISIZEOUT ! Size of global array passed out ORH3F403.121
&, IPROC ! Index for processes ORH3F403.122
&, INFO ORH3F403.123
&, MTAG ! message tag helps to ensure correct comms ORH3F403.124
ORH3F403.125
REAL RFIELDIN(ISIZEIN) ORH3F403.126
&, RFIELDOUT(ISIZEOUT) ORH3F403.127
ORH3F403.128
INTEGER IFIELDIN(ISIZEIN) ORH3F403.129
&, IFIELDOUT(ISIZEOUT) ORH3F403.130
ORH3F403.131
ORH3F403.132
! Now send these details to all other processes ORH3F403.133
DO I = 1,ISIZEIN ORH3F403.134
IF (TYPE.EQ.1) THEN ORH3F403.135
IFIELDOUT(ISTART+I-1) = IFIELDIN(I) ORH3F403.136
ELSE ORH3F403.137
RFIELDOUT(ISTART+I-1) = RFIELDIN(I) ORH3F403.138
ENDIF ORH3F403.139
ENDDO ORH3F403.140
ORH3F403.141
IF (O_MYPE.NE.0) THEN ORH3F403.142
MTAG = 6000 + O_MYPE ORH3F403.143
IF (TYPE.EQ.1) THEN ORH3F403.144
CALL GC_ISEND (MTAG,g_blsizep(2,O_MYPE),0,INFO, ORH3F403.145
& IFIELDOUT,IFIELDIN) ORH3F403.146
ELSE ORH3F403.147
CALL GC_RSEND (MTAG,g_blsizep(2,O_MYPE),0,INFO, ORH3F403.148
& RFIELDOUT,RFIELDIN) ORH3F403.149
ENDIF ORH3F403.150
ENDIF ORH3F403.151
ORH3F403.152
CALL GC_GSYNC(NPROC,INFO) ORH3F403.153
ORH3F403.154
IF (O_MYPE.EQ.0) THEN ORH3F403.155
ORH3F403.156
! For each process in turn ORH3F403.157
DO IPROC = 1, NPROC - 1 ORH3F403.158
ORH3F403.159
! Receive size of input array ORH3F403.160
MTAG = 6000 + IPROC ORH3F403.161
IF (TYPE.EQ.1) THEN ORH3F403.162
CALL GC_IRECV (MTAG,g_blsizep(2,IPROC),IPROC,INFO, ORH3F403.163
& IFIELDOUT(g_datastart(2,IPROC)),IFIELDIN) ORH3F403.164
ELSE ORH3F403.165
CALL GC_RRECV (MTAG,g_blsizep(2,IPROC),IPROC,INFO, ORH3F403.166
& RFIELDOUT(g_datastart(2,IPROC)),RFIELDIN) ORH3F403.167
ENDIF ORH3F403.168
ENDDO ORH3F403.169
ORH3F403.170
! Now we have the full field, broadcast to all other Pes ORH3F403.171
ENDIF ORH3F403.172
ORH3F403.173
MTAG = 8000 ORH3F403.174
IF (TYPE.EQ.1) THEN ORH3F403.175
CALL GC_IBCAST (MTAG,JMT_GLOBAL,0,NPROC,INFO,IFIELDOUT) ORH3F403.176
ELSE ORH3F403.177
CALL GC_RBCAST (MTAG,JMT_GLOBAL,0,NPROC,INFO,RFIELDOUT) ORH3F403.178
ENDIF ORH3F403.179
ORH3F403.180
ORH3F403.181
! FIELDOUT should now contain a full copy of the ORH3F403.182
! sub arrays concatenated from FIELDIN. ORH3F403.183
ORH3F403.184
RETURN ORH3F403.185
ORH3F403.186
END ORH3F403.187
*ENDIF OCNPASS.154