*IF DEF,CONTROL GLW1F404.12
*IF DEF,OCEAN ORH0F404.137
!+ Copies ocean data into stash workspace using a no.-of-levels array COPYODN1.2
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.15150
C GTS2F400.15151
C Use, duplication or disclosure of this code is subject to the GTS2F400.15152
C restrictions as set forth in the contract. GTS2F400.15153
C GTS2F400.15154
C Meteorological Office GTS2F400.15155
C London Road GTS2F400.15156
C BRACKNELL GTS2F400.15157
C Berkshire UK GTS2F400.15158
C RG12 2SZ GTS2F400.15159
C GTS2F400.15160
C If no contract has been raised with this copy of the code, the use, GTS2F400.15161
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.15162
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.15163
C Modelling at the above address. GTS2F400.15164
C ******************************COPYRIGHT****************************** GTS2F400.15165
C GTS2F400.15166
! COPYODN1.3
! Subroutine Interface: COPYODN1.4
SUBROUTINE COPYODIAGN(NX,NY,KM,STDVMD,VMD,DATA,FKM,STASHWORK) 4,1COPYODN1.5
COPYODN1.6
IMPLICIT NONE COPYODN1.7
! COPYODN1.8
! Description: COPYODN1.9
COPYODN1.10
! COPYODIAGN copies the data from the input 2D or 3D DATA array to COPYODN1.11
! the 1D STASHWORK array, in which they are arranged in the normal COPYODN1.12
! Fortran order. The data in STASHWORK is masked according to the COPYODN1.13
! supplied number-of-levels array FKM. FKM is a 2D array. In the case COPYODN1.14
! of a cylic ocean, the last two columns of FKM (NX-1:NX) correspond COPYODN1.15
! to wrap-round columns, and are ignored. STASHWORK contains data for COPYODN1.16
! row of length NX-2 in this case. If STDVMD is .TRUE., missing data COPYODN1.17
! is indicated by the standard missing data value. If STDVMD is COPYODN1.18
! .FALSE., the value of VMD is inserted at missing-data points. COPYODN1.19
COPYODN1.20
! To mask data of one level, call with KM=1. COPYODN1.21
COPYODN1.22
! The ...N suffix of the subroutine name indicates that the data is COPYODN1.23
! being masked with a number-of-levels array. The corresponding COPYODN1.24
! routine which masks with a logical array is called COPYODIAGL. A COPYODN1.25
! routine which copied without masking at all would be called COPYODN1.26
! COPYODIAG. COPYODN1.27
! COPYODN1.28
! Current Code Owner: J.M.Gregory COPYODN1.29
! COPYODN1.30
! History: COPYODN1.31
! Version Date Comment COPYODN1.32
! ------- ---- ------- COPYODN1.33
! 4.0 23.3.95 Original code. J.M.Gregory COPYODN1.34
! COPYODN1.35
! Code Description: COPYODN1.36
! Language: FORTRAN 77 + common extensions. COPYODN1.37
! This code is written to UMDP3 v6 programming standards. COPYODN1.38
! COPYODN1.39
! System component covered: <appropriate code> COPYODN1.40
! System Task: <appropriate code> COPYODN1.41
! COPYODN1.42
! Global variables COPYODN1.43
COPYODN1.44
! Input arguments COPYODN1.45
INTEGER COPYODN1.46
& NX ! 1st dimension of DATA, including wrap-round columns COPYODN1.47
&,NY ! 2nd dimension of DATA COPYODN1.48
&,KM ! 3rd dimension of DATA = no. of levels COPYODN1.49
COPYODN1.50
LOGICAL COPYODN1.51
& STDVMD ! Use standard value to indicate missing data COPYODN1.52
COPYODN1.53
REAL COPYODN1.54
& VMD ! Missing data value; ignored if .NOT.STDVMD COPYODN1.55
&,DATA(NX,NY,KM) ! Input data COPYODN1.56
&,FKM(NX,NY) ! Number of active levels at each point COPYODN1.57
COPYODN1.58
! Output arguments COPYODN1.59
REAL COPYODN1.60
& STASHWORK(*) ! Output stashwork array COPYODN1.61
COPYODN1.62
! Local variables COPYODN1.63
INTEGER COPYODN1.64
& I,J,K ! Indices into OCEAN COPYODN1.65
COPYODN1.66
LOGICAL COPYODN1.67
& OCEAN(NX,NY,KM) ! Ocean mask, .TRUE. where data is wanted COPYODN1.68
COPYODN1.69
! Function & Subroutine calls: COPYODN1.70
EXTERNAL COPYODIAGL COPYODN1.71
COPYODN1.72
!- End of header COPYODN1.73
COPYODN1.74
C Derive logical ocean mask from number-of-levels array COPYODN1.75
DO K=1,KM COPYODN1.76
DO J=1,NY COPYODN1.77
DO I=1,NX COPYODN1.78
OCEAN(I,J,K)=K.LE.INT(FKM(I,J)) COPYODN1.79
ENDDO COPYODN1.80
ENDDO COPYODN1.81
ENDDO COPYODN1.82
COPYODN1.83
C Perform copy COPYODN1.84
CALL COPYODIAGL
(NX,NY,KM,STDVMD,VMD,DATA,OCEAN,STASHWORK) COPYODN1.85
COPYODN1.86
C COPYODN1.87
RETURN COPYODN1.88
END COPYODN1.89
*ENDIF ORH0F404.138
*ENDIF GLW1F404.13