SUBROUTINE CHANGE_DECOMPOSITION(new_decomp,icode) 35CHDCMP1A.23
CHDCMP1A.24
IMPLICIT NONE CHDCMP1A.25
CHDCMP1A.26
! CHDCMP1A.27
! Description: CHDCMP1A.28
! Sets up the PARVARS common blocks with the correct information for CHDCMP1A.29
! decomposition new_decomp CHDCMP1A.30
! CHDCMP1A.31
! Method: CHDCMP1A.32
! If new_decomp is already the current decomposition, exit and do CHDCMP1A.33
! nothing. CHDCMP1A.34
! If decomposition new_decomp has not been initialised, print a CHDCMP1A.35
! message and exit, with icode=-1. CHDCMP1A.36
! Otherwise, copy the information from the decomp_db arrays in the CHDCMP1A.37
! DECOMPDB comdeck into the PARVARS comdecks arrays. CHDCMP1A.38
! CHDCMP1A.39
! Current Code Owner : Paul Burton CHDCMP1A.40
! CHDCMP1A.41
! History: CHDCMP1A.42
! Model Date Modification history from model version 4.2 CHDCMP1A.43
! version CHDCMP1A.44
! 4.2 22/8/96 New deck created for MPP code. P.Burton CHDCMP1A.45
! 4.3 17/02/97 Changed ICODE to a positive error no. P.Burton GPB3F403.77
! CHDCMP1A.46
! Subroutine arguments: CHDCMP1A.47
CHDCMP1A.48
INTEGER CHDCMP1A.49
& new_decomp ! IN : new decomposition to use CHDCMP1A.50
&, icode ! OUT: return code (-1 is failure) CHDCMP1A.51
CHDCMP1A.52
! Parameters and Common blocks CHDCMP1A.53
CHDCMP1A.54
*CALL PARVARS 
CHDCMP1A.55
*CALL DECOMPTP CHDCMP1A.56
*CALL DECOMPDB CHDCMP1A.57
CHDCMP1A.58
! Local variables CHDCMP1A.59
INTEGER ineb,idim,iproc CHDCMP1A.60
CHDCMP1A.61
CHDCMP1A.62
! ------------------------------------------------------------------ CHDCMP1A.63
CHDCMP1A.64
CHDCMP1A.66
! Check that the new_decomp argument is sensible CHDCMP1A.67
IF ((new_decomp .GT. max_decomps) .OR. CHDCMP1A.68
& ((new_decomp .LT. 1) .AND. (new_decomp .NE. decomp_unset))) CHDCMP1A.69
& THEN CHDCMP1A.70
IF (mype .EQ. 0) THEN CHDCMP1A.71
WRITE(6,*) 'Error: Cannot change to decomposition ', CHDCMP1A.72
& new_decomp CHDCMP1A.73
WRITE(6,*) 'This decomposition does not exist' CHDCMP1A.74
WRITE(6,*) 'Exiting.' CHDCMP1A.75
ENDIF CHDCMP1A.76
icode=1 GPB3F403.78
GOTO 999 CHDCMP1A.78
ENDIF CHDCMP1A.79
CHDCMP1A.80
! Check if this is already the current decomposition CHDCMP1A.81
CHDCMP1A.82
IF (new_decomp .EQ. current_decomp_type) GOTO 999 CHDCMP1A.83
CHDCMP1A.84
! Check to see if setting decomposition to unset CHDCMP1A.85
CHDCMP1A.86
IF (new_decomp .EQ. decomp_unset) THEN CHDCMP1A.87
current_decomp_type = decomp_unset CHDCMP1A.88
GOTO 999 CHDCMP1A.89
ENDIF CHDCMP1A.90
CHDCMP1A.91
! Check if this decomposition has been initialised CHDCMP1A.92
CHDCMP1A.93
IF ( .NOT. decomp_db_set(new_decomp) ) THEN CHDCMP1A.94
IF (mype .EQ. 0) THEN CHDCMP1A.95
WRITE(6,*) 'Error : Attempt to select uninitialised ', CHDCMP1A.96
& 'decomposition ',new_decomp CHDCMP1A.97
WRITE(6,*) 'Exiting.' CHDCMP1A.98
ENDIF CHDCMP1A.99
icode=1 GPB3F403.79
GOTO 999 CHDCMP1A.101
ENDIF CHDCMP1A.102
CHDCMP1A.103
! Now we can copy the information into PARVARS CHDCMP1A.104
CHDCMP1A.105
first_comp_pe=decomp_db_first_comp_pe(new_decomp) CHDCMP1A.106
last_comp_pe=decomp_db_last_comp_pe(new_decomp) CHDCMP1A.107
CHDCMP1A.108
nproc=decomp_db_nproc(new_decomp) CHDCMP1A.109
nproc_x=decomp_db_gridsize(1,new_decomp) CHDCMP1A.110
nproc_y=decomp_db_gridsize(2,new_decomp) CHDCMP1A.111
CHDCMP1A.112
Offx=decomp_db_halosize(1,new_decomp) CHDCMP1A.113
Offy=decomp_db_halosize(2,new_decomp) CHDCMP1A.114
CHDCMP1A.115
gc_proc_row_group=decomp_db_gc_proc_row_group(new_decomp) CHDCMP1A.116
gc_proc_col_group=decomp_db_gc_proc_col_group(new_decomp) CHDCMP1A.117
gc_all_proc_group=decomp_db_gc_all_proc_group(new_decomp) CHDCMP1A.118
CHDCMP1A.119
DO ineb=1,4 CHDCMP1A.120
neighbour(ineb)=decomp_db_neighbour(ineb,new_decomp) CHDCMP1A.121
ENDDO CHDCMP1A.122
CHDCMP1A.123
DO idim=1,Ndim_max CHDCMP1A.124
bound(idim)=decomp_db_bound(idim,new_decomp) CHDCMP1A.125
glsize(idim)=decomp_db_glsize(idim,new_decomp) CHDCMP1A.126
gridsize(idim)=decomp_db_gridsize(idim,new_decomp) CHDCMP1A.127
CHDCMP1A.128
ENDDO CHDCMP1A.129
CHDCMP1A.130
DO iproc=first_comp_pe,last_comp_pe CHDCMP1A.131
DO idim=1,Ndim_max CHDCMP1A.132
g_lasize(idim,iproc)= CHDCMP1A.133
& decomp_db_g_lasize(idim,iproc,new_decomp) CHDCMP1A.134
g_blsizep(idim,iproc)= CHDCMP1A.135
& decomp_db_g_blsizep(idim,iproc,new_decomp) CHDCMP1A.136
g_blsizeu(idim,iproc)= CHDCMP1A.137
& decomp_db_g_blsizeu(idim,iproc,new_decomp) CHDCMP1A.138
g_datastart(idim,iproc)= CHDCMP1A.139
& decomp_db_g_datastart(idim,iproc,new_decomp) CHDCMP1A.140
g_gridpos(idim,iproc)= CHDCMP1A.141
& decomp_db_g_gridpos(idim,iproc,new_decomp) CHDCMP1A.142
ENDDO CHDCMP1A.143
ENDDO CHDCMP1A.144
CHDCMP1A.145
DO idim=1,Ndim_max CHDCMP1A.146
lasize(idim)=g_lasize(idim,mype) CHDCMP1A.147
blsizep(idim)=g_blsizep(idim,mype) CHDCMP1A.148
blsizeu(idim)=g_blsizeu(idim,mype) CHDCMP1A.149
datastart(idim)=g_datastart(idim,mype) CHDCMP1A.150
gridpos(idim)=g_gridpos(idim,mype) CHDCMP1A.151
ENDDO CHDCMP1A.152
CHDCMP1A.153
atbase = ( gridpos(2) .EQ. (gridsize(2)-1)) CHDCMP1A.154
attop = ( gridpos(2) .EQ. 0) CHDCMP1A.155
atleft = (gridpos(1) .EQ. 0) CHDCMP1A.156
atright = ( gridpos(1) .EQ. (gridsize(1)-1)) CHDCMP1A.157
CHDCMP1A.158
current_decomp_type=new_decomp CHDCMP1A.159
CHDCMP1A.160
999 CONTINUE CHDCMP1A.161
CHDCMP1A.162
RETURN CHDCMP1A.163
END CHDCMP1A.164
CHDCMP1A.165
*ENDIF CHDCMP1A.166
*ENDIF GPB3F403.292