*IF DEF,OCEAN ORH1F305.467
C ******************************COPYRIGHT****************************** GTS2F400.7255
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.7256
C GTS2F400.7257
C Use, duplication or disclosure of this code is subject to the GTS2F400.7258
C restrictions as set forth in the contract. GTS2F400.7259
C GTS2F400.7260
C Meteorological Office GTS2F400.7261
C London Road GTS2F400.7262
C BRACKNELL GTS2F400.7263
C Berkshire UK GTS2F400.7264
C RG12 2SZ GTS2F400.7265
C GTS2F400.7266
C If no contract has been raised with this copy of the code, the use, GTS2F400.7267
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.7268
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.7269
C Modelling at the above address. GTS2F400.7270
C ******************************COPYRIGHT****************************** GTS2F400.7271
C GTS2F400.7272
C*LL Subroutine PIGSET PIGSET.3
CLL Can run on any FORTRAN 77 compiler with long lower case variables PIGSET.4
CLL PIGSET.5
CLL The code must be precompiled by the UPDOC system PIGSET.6
CLL PIGSET.7
CLL Author: N.K. TAYLOR PIGSET.8
CLL Date: 17 December 1993 PIGSET.9
CLL Version 3.3 PIGSET.10
CLL PIGSET.11
CLL Programming standards use Cox naming convention for Cox variables PIGSET.12
CLL with the addition that lower case variables are local to the PIGSET.13
CLL routine. PIGSET.14
CLL PIGSET.15
CLL This routine calculates the square root of the total pigment PIGSET.16
CLL concentration, for use by SOLSET and BIOLOGY. PIGSET.17
! Modification History: ORH1F305.4311
! Version Date Details ORH1F305.4312
! ------- ------- ------------------------------------------ ORH1F305.4313
! 3.5 16.01.95 Remove *IF dependency. R.Hill ORH1F305.4314
! 4.4 9.97 Use OBIOCONST comdeck for biology constants OJP0F404.622
! and remove zeroing of negative phyto OJP0F404.623
! and use PHYTO_TRACER index instead of '6' OJP0F404.624
! (JRPalmer) OJP0F404.625
C PIGSET.18
SUBROUTINE PIGSET (T,RTPIG, 1OJP0F404.626
& ISSW,IESW, ORH1F305.4315
+ IMT, KM, NT) PIGSET.20
C PIGSET.21
IMPLICIT NONE PIGSET.22
C PIGSET.23
*CALL CNTLOCN 
ORH1F305.4316
*CALL OARRYSIZ ORH1F305.4317
*CALL OTRACPNT OJP0F404.627
OJP0F404.628
C Define constants for array sizes PIGSET.24
C PIGSET.25
INTEGER PIGSET.26
+ IMT ! IN Number of points in horizontal PIGSET.27
+, KM ! IN Number of layers in model PIGSET.28
+, NT ! IN Number of tracers PIGSET.29
&, ISSW ! IN Start I - caters for cyclic conds ORH1F305.4318
&, IESW ! IN End I - caters for cyclic conds ORH1F305.4319
C PIGSET.30
C Physical arguments PIGSET.31
C PIGSET.32
REAL PIGSET.33
+ T (IMT, KM, NT) ! IN Tracer values OJP0F404.629
+ ,RTPIG (IMT,KM) ! OUT SQRT of total pigment conc. PIGSET.35
C* PIGSET.36
C PIGSET.37
*IF DEF,BIOLOGY ORH1F305.468
C PIGSET.38
C Locally defined variables PIGSET.39
C PIGSET.40
INTEGER PIGSET.41
+ I ! Horizontal loop index PIGSET.42
+ ,K ! Vertical loop index PIGSET.43
PIGSET.44
REAL PIGSET.45
+ fxa ! Intermediate scalar PIGSET.46
PIGSET.48
! Include the biology model constants, including the reals: OJP0F404.630
! c2n_P, c2chl, c_mol_wt, chl2pig OJP0F404.631
*CALL OBIOCONST OJP0F404.632
C PIGSET.55
C Compute square root of total pigment concentration. Total PIGSET.56
! pigment is proportional to Phytoplankton concentration. OJP0F404.633
C PIGSET.59
fxa = c2n_p * c_mol_wt / (c2chl * chl2pig) PIGSET.60
DO K=1,KM PIGSET.61
DO I = ISSW, IESW ORH1F305.4320
IF(T(I,K,PHYTO_TRACER).GE.0.0) then OJP0F404.634
RTPIG(I,K)=SQRT(T(I,K,PHYTO_TRACER)*fxa) OJP0F404.635
ELSE OJP0F404.636
RTPIG(I,K)=0.0 OJP0F404.637
ENDIF OJP0F404.638
ENDDO PIGSET.72
ENDDO PIGSET.73
PIGSET.74
IF (L_OCYCLIC) THEN ORH1F305.4321
C Set cyclic boundary condition for pigment ORH1F305.4322
DO K=1,KM ORH1F305.4323
RTPIG(1,K) = RTPIG(IMT-1,K) ORH1F305.4324
RTPIG(IMT,K) = RTPIG(2,K) ORH1F305.4325
ENDDO ORH1F305.4326
ENDIF ORH1F305.4327
C PIGSET.82
CL Return from PIGSET PIGSET.83
*ENDIF ORH1F305.469
C PIGSET.84
RETURN PIGSET.85
END PIGSET.86
C PIGSET.87
*ENDIF PIGSET.88