*IF DEF,S40_1A TRNA2S1A.2
C ******************************COPYRIGHT****************************** GTS2F400.10621
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.10622
C GTS2F400.10623
C Use, duplication or disclosure of this code is subject to the GTS2F400.10624
C restrictions as set forth in the contract. GTS2F400.10625
C GTS2F400.10626
C Meteorological Office GTS2F400.10627
C London Road GTS2F400.10628
C BRACKNELL GTS2F400.10629
C Berkshire UK GTS2F400.10630
C RG12 2SZ GTS2F400.10631
C GTS2F400.10632
C If no contract has been raised with this copy of the code, the use, GTS2F400.10633
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.10634
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.10635
C Modelling at the above address. GTS2F400.10636
C ******************************COPYRIGHT****************************** GTS2F400.10637
C GTS2F400.10638
C*LL TRNA2S1A.3
CLL SUBROUTINE TRANSA2S TRNA2S1A.4
CLL ------------------- TRNA2S1A.5
CLL TRNA2S1A.6
CLL THIS ROUTINE TRANSFERS DATA NEEDED FOR TRNA2S1A.7
CLL COUPLING FROM THE ATMOSPHERE TO THE SLAB OCEAN. TRNA2S1A.8
CLL IT CAN BE COMPILED BY CFT77, BUT DOES NOT CONFORM TO THE TRNA2S1A.9
CLL ANSI FORTRAN77 STANDARDS BECAUSE OF ENDDOs AND !COMMENTS SJT1F304.640
CLL CALLED BY: SLABCNTL TRNA2S1A.11
CLL VERSION NUMBER 1.1 TRNA2S1A.12
CLL WRITTEN BY D L ROBERTS (14/1/91) TRNA2S1A.13
CLL MODIFIED BY A.B.KEEN (02/02/93) TRNA2S1A.14
CLL MODIFIED BY C.A.SENIOR (22/03/93) SJT1F304.641
CLL MODIFIED BY C.A.SENIOR (08/07/93) SJT1F304.642
CLL MODIFIED BY C.A.SENIOR (25/02/94) SJT1F304.643
CLL REVIEWED BY W.INGRAM (01/03/93) TRNA2S1A.15
CLL FOLLOWS DOCUMENTATION PAPER 3, VERSION 5 FOR STANDARDS. TRNA2S1A.16
CLL DOCUMENTATION: UM DOCUMENTATION PAPER 58; THE SLAB OCEAN MODEL TRNA2S1A.17
CLLEND TRNA2S1A.18
C*L TRNA2S1A.19
C----------------------------------------------------------------- TRNA2S1A.20
C TRNA2S1A.21
SUBROUTINE TRANSA2S(L1,L2, 1SJT1F304.644
+ L_THERM, SJT1F304.645
+ LAND, SJT1F304.646
+ TSTARATM, SJT1F304.647
+ SLABTEMP, SJT1F304.648
+ HICEATM, SJT1F304.649
+ HICESLB, SJT1F304.650
+ HICEMIN, SJT1F304.651
+ HSNOWATM, SJT1F304.652
+ HSNOWSLB, SJT1F304.653
+ AICEATM, SJT1F304.654
+ AICESLB, SJT1F304.655
+ AICEMIN, SJT1F304.656
+ TCLIM, SJT1F304.657
+ TCLIMC, SJT1F304.658
+ HCLIM) SJT1F304.659
C TRNA2S1A.24
C TRNA2S1A.25
C THE FLOW OF CONTROL IS STRAIGHTFORWARD. TRNA2S1A.26
C TRNA2S1A.27
INTEGER SJT1F304.660
+ L1 ! IN SIZE OF DATA VECTORS SJT1F304.661
+,L2 ! IN AMOUNT OF DATA TO BE PROCESSED SJT1F304.662
C TRNA2S1A.29
LOGICAL LAND(L1) ! IN ATMOSPHERE MODEL LAND-SEA SJT1F304.663
+ ! MASK (FALSE AT OCEAN POINTS) TRNA2S1A.35
+,L_THERM ! IN TRUE FOR COUPLED MODEL TYPE SJT1F304.664
+ ! ICE THERMODYNAMICS SJT1F304.665
C TRNA2S1A.36
REAL TRNA2S1A.37
+ TSTARATM(L1) ! IN SURFACE TEMPERATURE OF ATMOSPHERE (K) SJT1F304.666
+,SLABTEMP(L1) ! INOUT SLAB OCEAN TEMP (C) SJT1F304.667
+,HICEATM(L1) ! IN EQUIVALENT ICE DEPTH FROM ATMOSPHERE SJT1F304.668
+ ! THIS IS THE DEPTH OF ICE THAT HAS THE TRNA2S1A.40
+ ! SAME THERMAL CONDUCTIVITY AS THE SEA-ICE TRNA2S1A.41
+ ! TOGETHER WITH THE SNOW TRNA2S1A.42
+,HICESLB(L1) ! OUT ICE DEPTH FOR USE IN SLAB (M) SJT1F304.669
+,HSNOWATM(L1) ! IN SNOW DEPTH FROM ATMOSPHERE (KG/M**2) SJT1F304.670
+,HSNOWSLB(L1) ! OUT SNOW DEPTH FOR USE IN SLAB (M) SJT1F304.671
+,AICEATM(L1) ! IN ICE CONCENTRATION FROM ATMOSPHERE SJT1F304.672
+,AICESLB(L1) ! OUT ICE CONCENTRATION FOR USE IN SLAB SJT1F304.673
+,TCLIM(L1) ! IN CLIMATOLOGICAL SST K SJT1F304.674
+,TCLIMC(L1) ! OUT CLIMATOLOGICAL SST C SJT1F304.675
+,HCLIM(L1) ! IN CLIMATOLOGICAL SEA-ICE DEPTH M SJT1F304.676
C TRNA2S1A.49
REAL TRNA2S1A.50
+ AICEMIN ! IN MINIMUM CONCENTRATION OF ICE IF ICE PRESENT SJT1F304.677
+,HICEMIN ! IN MINIMUM DEPTH OF ICE IF ICE PRESENT SJT1F304.678
+ ! PREVENTS SMALL ICE DEPTHS CAUSING FAILURE SJT1F304.679
C TRNA2S1A.52
C Include COMDECKS TRNA2S1A.53
C TRNA2S1A.54
*CALL C_SLAB 
TRNA2S1A.55
*CALL C_0_DG_C TRNA2S1A.56
*CALL C_MDI TRNA2S1A.57
C TRNA2S1A.58
C LOCAL VARIABLES TRNA2S1A.59
C TRNA2S1A.60
INTEGER TRNA2S1A.61
+ J ! LOOP COUNTER SJT1F304.680
C TRNA2S1A.63
REAL TFREEZE ! FREEZING POINT OF SEA WATER IN C TRNA2S1A.64
+,ONEEM8 ! SMALL +VE VALUE TO ELIMINATE ROUNDING SJT1F304.681
C TRNA2S1A.65
PARAMETER(TFREEZE = TFS - ZERODEGC) SJT1F304.682
PARAMETER(ONEEM8 = 1.0E-8 ) SJT1F304.683
C TRNA2S1A.67
C TRNA2S1A.68
C ----------------------------------------------------------- TRNA2S1A.69
C TRNA2S1A.70
DO J = 1,L2 SJT1F304.684
C TRNA2S1A.73
IF (.NOT. LAND(J)) THEN SJT1F304.685
C SJT1F304.686
C 1. CONVERT SLAB OCEAN TEMPERATURE AND CLIMATOLOGICAL SST SJT1F304.687
C FROM KELVIN TO CELSIUS AND SET SJT1F304.688
C VALUES OF SLABICE FOR ICE POINTS AND LAND POINTS. SJT1F304.689
C SJT1F304.690
C 2. CONVERT FROM EQUIVALENT ICE DEPTH SJT1F304.691
C TO MEAN ACTUAL ICE DEPTH SJT1F304.692
C NOTE THAT THE EXTRA PIECE OF ICE, HICEMIN, ADDED SJT1F304.693
C IN AT THE END OF THE LAST SLAB TIMESTEP TO PREVENT SJT1F304.694
C VERY SMALL ICE DEPTHS CAUSING THE ATMOSPHERE MODEL SJT1F304.695
C TO FAIL IS NOW REMOVED SJT1F304.696
C SJT1F304.697
IF (L_THERM) THEN SJT1F304.698
TCLIMC(J) = TCLIM(J) - ZERODEGC SJT1F304.699
ELSE TRNA2S1A.78
IF ( HCLIM(J) .LT. ONEEM8 ) THEN SJT1F304.700
TCLIMC(J) = TCLIM(J) - ZERODEGC SJT1F304.701
ELSE SJT1F304.702
TCLIMC(J) = TFREEZE SJT1F304.703
ENDIF SJT1F304.704
ENDIF TRNA2S1A.80
C SJT1F304.705
IF (l_therm) THEN SJT1F304.706
IF ( AICEATM(J) .LT. AICEMIN ) THEN SJT1F304.707
HICESLB(J) = 0.0 SJT1F304.708
ELSE SJT1F304.709
HICESLB(J) = AICEATM(J) * ( HICEATM(J) - SJT1F304.710
+ CONRATIO * ( HSNOWATM(J) / RHOSNOW ) ) SJT1F304.711
+ - HICEMIN SJT1F304.712
ENDIF SJT1F304.713
ELSE SJT1F304.714
IF ( AICEATM(J) .LT. AICEMIN ) THEN SJT1F304.715
SLABTEMP(J) = TSTARATM(J) - ZERODEGC SJT1F304.716
HICESLB(J) = 0.0 SJT1F304.717
ELSE SJT1F304.718
SLABTEMP(J) = TFREEZE SJT1F304.719
HICESLB(J) = AICEATM(J) * ( HICEATM(J) - SJT1F304.720
+ CONRATIO * ( HSNOWATM(J) / RHOSNOW ) ) SJT1F304.721
+ - HICEMIN SJT1F304.722
ENDIF SJT1F304.723
ENDIF SJT1F304.724
C SJT1F304.725
C 3. CONVERT SNOWDEPTH FROM KG/M**2 TO M SJT1F304.726
C SJT1F304.727
HSNOWSLB(J) = HSNOWATM(J) / RHOSNOW SJT1F304.728
C SJT1F304.729
C 4. INITIALISE THE ICE CONCENTRATIONS TO BE USED IN THE SJT1F304.730
C SLAB MODEL. NB THE 'OLD VALES' INPUT FROM THE ATMOSPHERE SJT1F304.731
C MUST BE SAVED AS THEY ARE USED BY THE ROUTINE SJT1F304.732
C TRANSS2A, HENCE THE TWO ARRAYS! SJT1F304.733
C SJT1F304.734
AICESLB(J) = AICEATM(J) SJT1F304.735
C SJT1F304.736
ELSE SJT1F304.737
C SJT1F304.738
SLABTEMP(J) = RMDI SJT1F304.739
TCLIMC(J) = RMDI SJT1F304.740
C SJT1F304.741
HSNOWSLB(J) = RMDI SJT1F304.742
C SJT1F304.743
HICESLB(J) = RMDI SJT1F304.744
C SJT1F304.745
AICESLB(J) = RMDI SJT1F304.746
C SJT1F304.747
ENDIF SJT1F304.748
END DO TRNA2S1A.84
C TRNA2S1A.131
RETURN TRNA2S1A.132
END TRNA2S1A.133
*ENDIF TRNA2S1A.134