*IF DEF,OCEAN @DYALLOC.4147
C ******************************COPYRIGHT****************************** GTS3F400.30
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS3F400.31
C GTS3F400.32
C Use, duplication or disclosure of this code is subject to the GTS3F400.33
C restrictions as set forth in the contract. GTS3F400.34
C GTS3F400.35
C Meteorological Office GTS3F400.36
C London Road GTS3F400.37
C BRACKNELL GTS3F400.38
C Berkshire UK GTS3F400.39
C RG12 2SZ GTS3F400.40
C GTS3F400.41
C If no contract has been raised with this copy of the code, the use, GTS3F400.42
C duplication or disclosure of it is strictly prohibited. Permission GTS3F400.43
C to do so must first be obtained in writing from the Head of Numerical GTS3F400.44
C Modelling at the above address. GTS3F400.45
C ******************************COPYRIGHT****************************** GTS3F400.46
C ****************************ACKNOWLEDGMENT*************************** GTS3F400.47
C This code is derived from Public Domain code (the Cox 1984 Ocean GTS3F400.48
C Model) distributed by the Geophysical Fluid Dynamics Laboratory. GTS3F400.49
C NOAA GTS3F400.50
C PO Box 308 GTS3F400.51
C Princeton GTS3F400.52
C New Jersey USA GTS3F400.53
C If you wish to obtain a copy of the original code that does not have GTS3F400.54
C Crown Copyright use, duplication or disclosure restrictions, please GTS3F400.55
C contact them at the above address. GTS3F400.56
C ****************************ACKNOWLEDGMENT*************************** GTS3F400.57
C GTS3F400.58
SUBROUTINE MATRIX(ARRAY,IRDIM,ISTRT,IM,JM,KK,SCALE, 27,2ORH4F404.95
& OFF1,OFF2) ORH4F404.96
C MATRIX.3
C======================================================================= MATRIX.4
C === MATRIX.5
C MATRIX IS A GENERAL TWO-DIMENSIONAL ARRAY PRINTING ROUTINE, === MATRIX.6
C WHERE: === MATRIX.7
C ARRAY=THE ARRAY TO BE PRINTED (!!!!! FULL PRECISION !!!!!) === MATRIX.8
C IRDIM=THE 1ST DIMENSION OF ARRAY === MATRIX.9
C ISTRT=THE 1ST ELEMENT OF THE 1ST DIMENSION TO BE PRINTED === MATRIX.10
C IM =THE LAST ELEMENT OF THE 1ST DIMENSION TO BE PRINTED === MATRIX.11
C JM =THE LAST ELEMENT OF THE 2ND DIMENSION TO BE PRINTED === MATRIX.12
C --THE ROWS ARE PRINTED IN DESCENDING ORDER-- === MATRIX.13
C (IF THIS IS 0, KK IS USED) === MATRIX.14
C KK =THE LAST ELEMENT OF THE 2ND DIMENSION TO BE PRINTED === MATRIX.15
C --THE ROWS ARE PRINTED IN ASCENDING ORDER-- === MATRIX.16
C (IF THIS IS 0, JM IS USED) === MATRIX.17
C SCALE=A SCALING FACTOR BY WHICH ARRAY IS DIVIDED BEFORE === MATRIX.18
C PRINTING. (IF THIS IS ZERO, NO SCALING IS DONE.) === MATRIX.19
C IF SCALE=0, 10 COLUMNS ARE PRINTED ACROSS IN E FORMAT === MATRIX.20
C IF SCALE>0, 20 COLUMNS ARE PRINTED ACROSS IN F FORMAT === MATRIX.21
! 3.5 16.01.95 Remove *IF dependency. R.Hill ORH1F305.4879
C === MATRIX.22
C======================================================================= MATRIX.23
C MATRIX.24
! MODIFICATION HISTORY ORH4F404.88
! -------------------- ORH4F404.89
! ORH4F404.90
! Version Date Description ORH4F404.91
! ------- -------- --------------------------------------------- ORH4F404.92
! 4.4 05/08/97 Change PRINTS to WRITES to make output ORH4F404.93
! consistent in mpp version. R. Hill ORH4F404.94
!LL 4.5 17/09/98 Update calls to timer, required because of GPB8F405.96
!LL new barrier inside timer. P.Burton GPB8F405.97
C--------------------------------------------------------------------- MATRIX.25
C DEFINE GLOBAL DATA MATRIX.26
C--------------------------------------------------------------------- MATRIX.27
! IMPLICIT NONE ORH1F305.4880
ORH1F305.4881
*CALL OTIMER 
ORH1F305.4882
C MATRIX.28
C MATRIX.30
C--------------------------------------------------------------------- MATRIX.31
C DEFINE LOCAL DATA MATRIX.32
C--------------------------------------------------------------------- MATRIX.33
C MATRIX.34
DIMENSION ARRAY(IRDIM,*),NUM(20),PLINE(20) @DYALLOC.4148
REAL ARRAY MATRIX.36
INTEGER OFF1 ! Offset for 1st dimension indices ORH4F404.97
& ,OFF2 ! Offset for 2nd dimension indices ORH4F404.98
C--------------------------------------------------------------------- MATRIX.38
C BEGIN EXECUTABLE CODE MATRIX.39
C--------------------------------------------------------------------- MATRIX.40
C MATRIX.41
IF(L_OTIMER) THEN ORH1F305.4883
CALL TIMER('MATRIX ',103) GPB8F405.98
ENDIF ORH1F305.4885
IF(SCALE.NE.0) GO TO 500 MATRIX.45
DO 251 IS=ISTRT,IM,10 MATRIX.46
IE=IS+9 MATRIX.47
IF(IE.GT.IM) IE=IM MATRIX.48
IDIF=IE-IS+1 MATRIX.49
DO 100 I=1,IDIF MATRIX.50
100 NUM(I)=IS+I-1+OFF1 ORH4F404.99
WRITE(6,9990) (NUM(I),I=1,IDIF) ORH4F404.100
9990 FORMAT(10I13,/) MATRIX.53
JMORKM=JM+KK MATRIX.54
DO 252 JORK=1,JMORKM MATRIX.55
IF(JM.NE.0) L=JMORKM+1-JORK MATRIX.56
IF(KK.NE.0) L=JORK MATRIX.57
WRITE(6,9966) L+OFF2, (ARRAY(I,L),I=IS,IE) ORH4F404.101
252 CONTINUE MATRIX.59
WRITE(6,9984) ORH4F404.102
251 CONTINUE MATRIX.61
9966 FORMAT(1X,I2,10(1PE13.5)) MATRIX.62
9984 FORMAT(//) MATRIX.63
RETURN MATRIX.64
500 CONTINUE MATRIX.65
SCALER=1.0/SCALE MATRIX.66
DO 751 IS=ISTRT,IM,20 MATRIX.67
IE=IS+19 MATRIX.68
IF(IE.GT.IM) IE=IM MATRIX.69
IDIF=IE-IS+1 MATRIX.70
DO 600 I=1,IDIF MATRIX.71
600 NUM(I)=IS+I-1+OFF1 ORH4F404.103
WRITE(6,9991) (NUM(I),I=1,IDIF) ORH4F404.104
9991 FORMAT(3X,20I6,/) MATRIX.74
JMORKM=JM+KK MATRIX.75
DO 752 JORK=1,JMORKM MATRIX.76
IF(JM.NE.0) L=JMORKM+1-JORK MATRIX.77
IF(KK.NE.0) L=JORK MATRIX.78
DO 753 I=1,IDIF MATRIX.79
PLINE(I)=ARRAY(IS+I-1,L)*SCALER MATRIX.80
753 CONTINUE MATRIX.81
WRITE(6,9967) L+OFF2,(PLINE(I),I=1,IDIF) ORH4F404.105
752 CONTINUE MATRIX.83
WRITE(6,9984) ORH4F404.106
751 CONTINUE MATRIX.85
9967 FORMAT(1X,I3,1X,20F6.2) MATRIX.86
IF(L_OTIMER) THEN ORH1F305.4886
CALL TIMER('MATRIX ',104) GPB8F405.99
ENDIF ORH1F305.4888
RETURN MATRIX.90
END MATRIX.91
*ENDIF @DYALLOC.4149