SUBROUTINE SET_SIDES(FIELD,P_FIELD,ROW_LENGTH,N_LEVS,FLD_TYPE) 10GPB0F401.566
STSIDE1A.7
IMPLICIT NONE STSIDE1A.8
! STSIDE1A.9
! Description: STSIDE1A.10
! This routine fills in the north and south halos of the global STSIDE1A.11
! data with sensible numbers. If *DEF,GLOBAL is not set it will STSIDE1A.12
! also fill in the east and west halos. These halos are not filled STSIDE1A.13
! by a call to SWAPBOUNDS, so this routine ensures they are all STSIDE1A.14
! initialised to reasonable numbers. STSIDE1A.15
! STSIDE1A.16
! Method: STSIDE1A.17
! "Sensible numbers" are obtained by copying data one row/column STSIDE1A.18
! in from the halo. In the case of the southern halo, data is STSIDE1A.19
! copied from two rows up. STSIDE1A.20
! STSIDE1A.21
! Current Code Owner: Paul Burton STSIDE1A.22
! STSIDE1A.23
! History: STSIDE1A.24
! Model Date Modification history from model version 3.5 STSIDE1A.25
! version STSIDE1A.26
! 3.5 9/1/95 New DECK created for the Parallel Unified STSIDE1A.27
! Model. P.Burton STSIDE1A.28
! 4.1 18/3/96 Added FLD_TYPE argument P.Burton GPB0F401.567
! STSIDE1A.29
! Subroutine Arguments: STSIDE1A.30
STSIDE1A.31
INTEGER P_FIELD, N_LEVS, ROW_LENGTH ! IN size of FIELD STSIDE1A.32
INTEGER FLD_TYPE ! indicates type (P or U) of field GPB0F401.568
STSIDE1A.33
REAL FIELD(P_FIELD,N_LEVS) ! IN/OUT field to work on STSIDE1A.34
STSIDE1A.35
! Parameters and Common blocks STSIDE1A.36
STSIDE1A.37
*CALL PARVARS 
STSIDE1A.38
STSIDE1A.39
! Local variables STSIDE1A.40
STSIDE1A.41
INTEGER I,J,K ! loop counters STSIDE1A.42
INTEGER I_off_halo,I_off_data ! offsets from halo to data STSIDE1A.43
INTEGER J_end ! loop bound GPB0F401.569
*IF -DEF,GLOBAL STSIDE1A.44
INTEGER I_start,I_end ! loop bounds STSIDE1A.45
*ENDIF STSIDE1A.46
! ------------------------------------------------------------------ STSIDE1A.47
STSIDE1A.48
! Do North halo STSIDE1A.49
IF (attop) THEN STSIDE1A.50
I_off_data=ROW_LENGTH*Offy STSIDE1A.51
DO K=1,N_LEVS STSIDE1A.52
DO J=1,Offy STSIDE1A.53
I_off_halo=(J-1)*ROW_LENGTH STSIDE1A.54
DO I=1,ROW_LENGTH STSIDE1A.55
FIELD(I+I_off_halo,K)=FIELD(I+I_off_data,K) STSIDE1A.56
ENDDO STSIDE1A.57
ENDDO STSIDE1A.58
ENDDO STSIDE1A.59
ENDIF STSIDE1A.60
STSIDE1A.61
! Now South halo STSIDE1A.62
IF (atbase) THEN STSIDE1A.63
I_off_data=ROW_LENGTH*(Offy+1) ! Offy+1 in case it is at the STSIDE1A.64
! ! base of a U grid - this makes STSIDE1A.65
! ! sure we get some proper data STSIDE1A.66
DO K=1,N_LEVS STSIDE1A.67
IF (FLD_TYPE .EQ. fld_type_u) THEN GPB0F401.570
J_end=Offy+1 GPB0F401.571
ELSE GPB0F401.572
J_end=Offy GPB0F401.573
ENDIF GPB0F401.574
DO J=1,J_end GPB0F401.575
I_off_halo=(J-1)*ROW_LENGTH STSIDE1A.69
DO I=1,ROW_LENGTH STSIDE1A.70
FIELD(P_FIELD+1-I-I_off_halo,K)= STSIDE1A.71
& FIELD(P_FIELD+1-I-I_off_data,K) STSIDE1A.72
ENDDO STSIDE1A.73
ENDDO STSIDE1A.74
ENDDO STSIDE1A.75
ENDIF STSIDE1A.76
STSIDE1A.77
*IF DEF,GLOBAL STSIDE1A.78
C Nothing needed, since swaps automatically fill in the halos STSIDE1A.79
C at the global east/west edge halos STSIDE1A.80
*ELSE STSIDE1A.81
! Now West halo STSIDE1A.82
IF (atleft) THEN STSIDE1A.83
I_start=1 STSIDE1A.84
I_end=P_FIELD-ROW_LENGTH+1 STSIDE1A.85
DO K=1,N_LEVS STSIDE1A.86
DO I=I_start,I_end,ROW_LENGTH STSIDE1A.87
DO J=I, I+(Offx-1) STSIDE1A.88
FIELD(J,K)=FIELD(I+Offx,K) STSIDE1A.89
ENDDO STSIDE1A.90
ENDDO STSIDE1A.91
ENDDO STSIDE1A.92
ENDIF STSIDE1A.93
STSIDE1A.94
! and finally East halo STSIDE1A.95
IF (atright) THEN STSIDE1A.96
I_start=ROW_LENGTH STSIDE1A.97
I_end=P_FIELD STSIDE1A.98
DO K=1,N_LEVS STSIDE1A.99
DO I=I_start,I_end,ROW_LENGTH STSIDE1A.100
DO J=I-(Offx-1),I STSIDE1A.101
FIELD(J,K)=FIELD(I-Offx,K) STSIDE1A.102
ENDDO STSIDE1A.103
ENDDO STSIDE1A.104
ENDDO STSIDE1A.105
ENDIF STSIDE1A.106
STSIDE1A.107
*ENDIF STSIDE1A.108
RETURN STSIDE1A.109
END STSIDE1A.110
STSIDE1A.111
*ENDIF STSIDE1A.112
*ENDIF GPB3F403.265