*IF DEF,CONTROL,AND,DEF,OCEAN INITDIO1.2
C ******************************COPYRIGHT****************************** INITDIO1.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. INITDIO1.4
C INITDIO1.5
C Use, duplication or disclosure of this code is subject to the INITDIO1.6
C restrictions as set forth in the contract. INITDIO1.7
C INITDIO1.8
C Meteorological Office INITDIO1.9
C London Road INITDIO1.10
C BRACKNELL INITDIO1.11
C Berkshire UK INITDIO1.12
C RG12 2SZ INITDIO1.13
C INITDIO1.14
C If no contract has been raised with this copy of the code, the use, INITDIO1.15
C duplication or disclosure of it is strictly prohibited. Permission INITDIO1.16
C to do so must first be obtained in writing from the Head of Numerical INITDIO1.17
C Modelling at the above address. INITDIO1.18
C ******************************COPYRIGHT****************************** INITDIO1.19
C INITDIO1.20
CLL Subroutine INITDIAGO ------------------------------------------- INITDIO1.21
CLL INITDIO1.22
CLL Purpose : Calls STASH to allow output of ocean diagnostics INITDIO1.23
CLL from D1 array at timestep 0. INITDIO1.24
CLL INITDIO1.25
CLL Control routine INITDIO1.26
CLL INITDIO1.27
CLL Author: R. Hill INITDIO1.28
CLL INITDIO1.29
CLL Date: September 1997 INITDIO1.30
CLL INITDIO1.31
CLL Model Modification history from model version 4.4: INITDIO1.32
CLL version Date INITDIO1.33
CLL INITDIO1.34
CLL Programming standard; Unified Model Documentation Paper No. 3 INITDIO1.35
CLLEND------------------------------------------------------------ INITDIO1.36
INITDIO1.37
SUBROUTINE INITDIAGO( 1,1INITDIO1.38
*CALL ARGSIZE 
INITDIO1.39
*CALL ARGD1 INITDIO1.40
*CALL ARGDUMA INITDIO1.41
*CALL ARGDUMO INITDIO1.42
*CALL ARGDUMW INITDIO1.43
*CALL ARGSTS INITDIO1.44
*CALL ARGPTRA INITDIO1.45
*CALL ARGPTRO INITDIO1.46
*CALL ARGCONA INITDIO1.47
*CALL ARGPPX INITDIO1.48
& ICODE,CMESSAGE) INITDIO1.49
INITDIO1.50
INITDIO1.51
IMPLICIT NONE INITDIO1.52
INITDIO1.53
*CALL CMAXSIZE INITDIO1.54
*CALL CSUBMODL INITDIO1.55
*CALL TYPSIZE INITDIO1.56
*CALL TYPD1 INITDIO1.57
*CALL TYPDUMA INITDIO1.58
*CALL TYPDUMO INITDIO1.59
*CALL TYPDUMW INITDIO1.60
*CALL TYPSTS INITDIO1.61
*CALL TYPPTRA INITDIO1.62
*CALL TYPPTRO INITDIO1.63
*CALL TYPCONA INITDIO1.64
*CALL PPXLOOK INITDIO1.65
INITDIO1.66
INTEGER INITDIO1.67
& ICODE ! Out return code : 0 Normal exit INITDIO1.68
! : >0 Error exit INITDIO1.69
INITDIO1.70
CHARACTER*80 INITDIO1.71
& CMESSAGE ! Out error message if ICODE > 0 INITDIO1.72
INITDIO1.73
INITDIO1.74
! local variables INITDIO1.75
INITDIO1.76
INTEGER INITDIO1.77
& I INITDIO1.78
& ,im_ident ! Internal Model Identifier INITDIO1.79
& ,im_index ! Internal Model Index for stash arrays INITDIO1.80
INITDIO1.81
! External subroutines called INITDIO1.82
INITDIO1.83
EXTERNAL STASH INITDIO1.84
INITDIO1.85
!---------------------------------------------------------------------- INITDIO1.86
INITDIO1.87
! Set to ocean internal model INITDIO1.88
im_ident = ocean_im INITDIO1.89
im_index = internal_model_index(im_ident) INITDIO1.90
INITDIO1.91
INITDIO1.92
CALL STASH(o_sm,o_im,0,D1, INITDIO1.93
*CALL ARGSIZE INITDIO1.94
*CALL ARGD1 INITDIO1.95
*CALL ARGDUMA INITDIO1.96
*CALL ARGDUMO INITDIO1.97
*CALL ARGDUMW INITDIO1.98
*CALL ARGSTS INITDIO1.99
*CALL ARGPPX INITDIO1.100
& ICODE,CMESSAGE) INITDIO1.101
INITDIO1.102
INITDIO1.103
RETURN INITDIO1.104
END INITDIO1.105
*ENDIF INITDIO1.106