*IF DEF,OCEAN                                                              OVISCALC.2      
C *****************************COPYRIGHT******************************     OVISCALC.3      
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved.    OVISCALC.4      
C                                                                          OVISCALC.5      
C Use, duplication or disclosure of this code is subject to the            OVISCALC.6      
C restrictions as set forth in the contract.                               OVISCALC.7      
C                                                                          OVISCALC.8      
C                Meteorological Office                                     OVISCALC.9      
C                London Road                                               OVISCALC.10     
C                BRACKNELL                                                 OVISCALC.11     
C                Berkshire UK                                              OVISCALC.12     
C                RG12 2SZ                                                  OVISCALC.13     
C                                                                          OVISCALC.14     
C If no contract has been raised with this copy of the code, the use,      OVISCALC.15     
C duplication or disclosure of it is strictly prohibited.  Permission      OVISCALC.16     
C to do so must first be obtained in writing from the Head of Numerical    OVISCALC.17     
C Modelling at the above address.                                          OVISCALC.18     
C ******************************COPYRIGHT******************************    OVISCALC.19     

      SUBROUTINE VISBECK_CALC(                                              1,5OVISCALC.20     
     & athkdft                                                             OVISCALC.21     
*CALL ARGOC2DG                                                             OVISCALC.22     
     &,CST,DXT,DYT                                                         OVISCALC.23     
     &,IMT,JMT,IMT_VIS,JMT_VIS,IMT_IPD,IMTM2,JMT_GLOBAL                    OVISCALC.24     
     &,JST,JFIN,J_1,J_JMT,O_MYPE,L_OVISHADCM4                              OVISCALC.25     
     &)                                                                    OVISCALC.26     
! Description: This subroutine handles the main length scale               OVISCALC.27     
!              calculations for the VISBECK scheme. Use of this            OVISCALC.28     
!              subroutine allows memory reuse which is important           OVISCALC.29     
!              because several large arrays are only needed                OVISCALC.30     
!              temporarily.                                                OVISCALC.31     
!              Calculate length scale for Visbeck scheme if this           OVISCALC.32     
!              is a mixing timestep. lscale is the min number of           OVISCALC.33     
!              grid points needed to find a value of tmin1 le              OVISCALC.34     
!              tmin1_max (set to min 1 max 7).                             OVISCALC.35     
!                                                                          OVISCALC.36     
! Author:      R. Hill                                                     OVISCALC.37     
!                                                                          OVISCALC.38     
! Date:        June 1998                                                   OVISCALC.39     
!                                                                          OVISCALC.40     
! Modification History                                                     OVISCALC.41     
!                                                                          OVISCALC.42     
! Date     Name        Description                                         OVISCALC.43     
! ------   ----------  ------------------------------------------          OVISCALC.44     
!                                                                          OVISCALC.45     
!###################################################################       OVISCALC.46     
      IMPLICIT NONE                                                        OVISCALC.47     
                                                                           OVISCALC.48     
*CALL PARVARS                                                              OVISCALC.49     
                                                                           OVISCALC.51     
!-----------------------------------------------------------------         OVISCALC.52     
!     Input dimensions etc                                                 OVISCALC.53     
!-----------------------------------------------------------------         OVISCALC.54     
      INTEGER                                                              OVISCALC.55     
     & IMT,JMT,IMT_VIS,JMT_VIS,IMT_IPD,IMTM2,JMT_GLOBAL                    OVISCALC.56     
     &,JST,JFIN,J_1,J_JMT,O_MYPE                                           OVISCALC.57     
                                                                           OVISCALC.58     
      REAL                                                                 OVISCALC.59     
     & athkdft(imt_vis,jmt_vis) ! IN/OUT diffsn coeff on T grid            OVISCALC.60     
     &,CST(JMT)                 ! IN                                       OVISCALC.61     
     &,DXT(IMT)                 ! IN                                       OVISCALC.62     
     &,DYT(JMT)                 ! IN                                       OVISCALC.63     
                                                                           OVISCALC.64     
      LOGICAL                                                              OVISCALC.65     
     & L_OVISHADCM4             ! hadcm4 version of visbeck scheme         OVISCALC.66     
                                                                           OVISCALC.67     
*CALL TYPOC2DG                                                             PXORDER.40     
                                                                           PXORDER.41     
!======================================================================    OVISCALC.68     
! Local variables to this routine.                                         OVISCALC.69     
!======================================================================    OVISCALC.70     
      INTEGER I                                                            OVISCALC.71     
     &,       J                                                            OVISCALC.72     
     &,ngap         ! \   gaps to N,S,E and W resp. used for               OVISCALC.73     
     &,sgap         !  |  calculating length scale for Visbeck             OVISCALC.74     
     &,egap         !  |  scheme                                           OVISCALC.75     
     &,wgap         ! /                                                    OVISCALC.76     
     &,ipos,jpos    ! \  used for calculating length scale                 OVISCALC.77     
     &,nstot,ewtot  ! /  for Visbeck scheme                                OVISCALC.78     
     &,info      ! return code from scatter_field,gather_field             OVISCALC.79     
                                                                           OVISCALC.80     
      REAL tmin1_max ! lscale=min no. grdpts to find tmin1 < tmin1_max     OVISCALC.81     
     &,CST_GLOBAL(jmt_global) ! global version of CST                      OVISCALC.82     
     &,DYT_GLOBAL(jmt_global) ! global version of DYT                      OVISCALC.83     
     &,tmin1_global(imt,jmt_global) ! global field of tmin1                OVISCALC.84     
     &,fract                ! used for calculating length scale            OVISCALC.85     
     &,athkdft_max                                                         OVISCALC.86     
     &,athkdft_min ! Max and min values allowed for athkdft                OVISCALC.87     
     &,lscale(imt_vis,jmt_vis)           ! length scale                    OVISCALC.88     
     &,lscale_global(imt_ipd,jmt_global) ! global field of lscale          OVISCALC.89     
!======================================================================    OVISCALC.90     
                                                                           OVISCALC.91     
c The value for tmin1_max is hardwired at the moment and was               OVISCALC.92     
c chosen as a result of experimentation. This needs further work           OVISCALC.93     
c and may be altered in the future.                                        OVISCALC.94     
      IF (L_OVISHADCM4) THEN                                               OVISCALC.95     
         tmin1_max=1.7e-6                                                  OVISCALC.96     
      ELSE                                                                 OVISCALC.97     
         tmin1_max=1.4e-6                                                  OVISCALC.98     
      ENDIF                                                                OVISCALC.99     
                                                                           OVISCALC.100    
*IF DEF,MPP                                                                OVISCALC.101    
c The following calculation needs to be on 1PE for MPP machine             OVISCALC.102    
c since requires several rows to N or S                                    OVISCALC.103    
c Create a global copy of CST and DYT                                      OVISCALC.104    
      CALL O_SMARTPASS(1,1,CST(J_1),CST_GLOBAL                             OVISCALC.105    
     &                ,JFIN-JST+1,JMT_GLOBAL,JST,2)                        OVISCALC.106    
      CALL O_SMARTPASS(1,1,DYT(J_1),DYT_GLOBAL                             OVISCALC.107    
     &                ,JFIN-JST+1,JMT_GLOBAL,JST,2)                        OVISCALC.108    
c Gather field tmin1 onto processor 0                                      OVISCALC.109    
      CALL GATHER_FIELD(tmin1,tmin1_global,imt,jmt,imt,                    OVISCALC.110    
     &                 jmt_global,0,GC_ALL_PROC_GROUP,info)                OVISCALC.111    
*ELSE                                                                      OVISCALC.112    
C Set up for non mpp code.                                                 OVISCALC.113    
      DO J = J_1, J_JMT                                                    OVISCALC.114    
         CST_GLOBAL(J)=CST(J)                                              OVISCALC.115    
         DYT_GLOBAL(J)=DYT(J)                                              OVISCALC.116    
         do i=1,imt                                                        OVISCALC.117    
            tmin1_global(i,j)=tmin1(i,j)                                   OVISCALC.118    
         enddo                                                             OVISCALC.119    
      ENDDO                                                                OVISCALC.120    
*ENDIF                                                                     OVISCALC.121    
c Calculate length scale                                                   OVISCALC.122    
*IF DEF,MPP                                                                OVISCALC.123    
      IF (O_MYPE.EQ.0) THEN                                                OVISCALC.124    
*ENDIF                                                                     OVISCALC.125    
          do j=1,jmt_global                                                OVISCALC.126    
            do i=1,imt                                                     OVISCALC.127    
              if (tmin1_global(i,j) .le. tmin1_max) then                   OVISCALC.128    
                if (L_OVISHADCM4) THEN                                     OVISCALC.129    
                  lscale_global(i,j)=DYT_GLOBAL(j)                         OVISCALC.130    
                else                                                       OVISCALC.131    
                  lscale_global(i,j)=1.                                    OVISCALC.132    
                endif                                                      OVISCALC.133    
              else                                                         OVISCALC.134    
c  scan north                                                              OVISCALC.135    
                ngap=0                                                     OVISCALC.136    
  100           continue                                                   OVISCALC.137    
                  ngap=ngap+1                                              OVISCALC.138    
                  jpos=j+ngap                                              OVISCALC.139    
                  if (jpos .gt. jmt_global .or. ngap .gt. 10) then         OVISCALC.140    
                    goto 200                                               OVISCALC.141    
                  else                                                     OVISCALC.142    
                    if (tmin1_global(i,jpos) .le. tmin1_max                OVISCALC.143    
     &                 ) goto 200                                          OVISCALC.144    
                  endif                                                    OVISCALC.145    
                goto 100                                                   OVISCALC.146    
  200           continue                                                   OVISCALC.147    
c  scan south                                                              OVISCALC.148    
                sgap=0                                                     OVISCALC.149    
  300           continue                                                   OVISCALC.150    
                  sgap=sgap+1                                              OVISCALC.151    
                  jpos=j-sgap                                              OVISCALC.152    
                  if (jpos .lt. 1 .or. sgap .gt. 10) then                  OVISCALC.153    
                    goto 400                                               OVISCALC.154    
                  else                                                     OVISCALC.155    
                    if (tmin1_global(i,jpos) .le. tmin1_max                OVISCALC.156    
     &                 ) goto 400                                          OVISCALC.157    
                  endif                                                    OVISCALC.158    
                goto 300                                                   OVISCALC.159    
  400           continue                                                   OVISCALC.160    
c  scan west                                                               OVISCALC.161    
                wgap=0                                                     OVISCALC.162    
  500           continue                                                   OVISCALC.163    
                  wgap=wgap+1                                              OVISCALC.164    
                  ipos=i-wgap                                              OVISCALC.165    
                  if (wgap .gt. 10) goto 600                               OVISCALC.166    
                  if (ipos .lt. 1 ) ipos=ipos+imtm2                        OVISCALC.167    
                    if (tmin1_global(ipos,j) .le. tmin1_max                OVISCALC.168    
     &                 ) goto 600                                          OVISCALC.169    
                goto 500                                                   OVISCALC.170    
  600           continue                                                   OVISCALC.171    
c  scan east                                                               OVISCALC.172    
                egap=0                                                     OVISCALC.173    
  700             continue                                                 OVISCALC.174    
                  egap=egap+1                                              OVISCALC.175    
                  ipos=i+egap                                              OVISCALC.176    
                  if (egap .gt. 10) goto 800                               OVISCALC.177    
                  if (ipos .gt. imt) ipos=ipos-imt                         OVISCALC.178    
                    if (tmin1_global(ipos,j) .le. tmin1_max                OVISCALC.179    
     &                 )  goto 800                                         OVISCALC.180    
                goto 700                                                   OVISCALC.181    
  800           continue                                                   OVISCALC.182    
                                                                           OVISCALC.183    
c Now find out which dirn is the least NS or EW                            OVISCALC.184    
                                                                           OVISCALC.185    
                nstot=DYT_GLOBAL(j)*float(ngap+sgap)                       OVISCALC.186    
                ewtot=CST_GLOBAL(j)*DXT(i)*float(egap+wgap)                OVISCALC.187    
                                                                           OVISCALC.188    
                if (nstot .lt. ewtot) then                                 OVISCALC.189    
                  fract=min(float(ngap),float(sgap))/                      OVISCALC.190    
     &                  max(float(ngap),float(sgap))                       OVISCALC.191    
                  lscale_global(i,j)=fract*nstot                           OVISCALC.192    
                else                                                       OVISCALC.193    
                  fract=min(float(egap),float(wgap))/                      OVISCALC.194    
     &                  max(float(egap),float(wgap))                       OVISCALC.195    
                  lscale_global(i,j)=fract*ewtot                           OVISCALC.196    
                endif                                                      OVISCALC.197    
                if (L_OVISHADCM4) THEN                                     OVISCALC.198    
             lscale_global(i,j)=max(dyt_global(j),lscale_global(i,j))      OVISCALC.199    
                endif                                                      OVISCALC.200    
              endif                                                        OVISCALC.201    
            enddo                                                          OVISCALC.202    
          enddo                                                            OVISCALC.203    
*IF DEF,MPP                                                                OVISCALC.204    
      ENDIF ! if O_MYPE=0                                                  OVISCALC.205    
*ENDIF                                                                     OVISCALC.206    
*IF DEF,MPP                                                                OVISCALC.207    
c Scatter lscale and tmin1 back to individual processors                   OVISCALC.208    
      CALL SCATTER_FIELD(lscale,lscale_global,imt,jmt,imt,                 OVISCALC.209    
     &                   jmt_global,0,GC_ALL_PROC_GROUP,info)              OVISCALC.210    
      CALL SCATTER_FIELD(tmin1,tmin1_global,imt,jmt,imt,                   OVISCALC.211    
     &                   jmt_global,0,GC_ALL_PROC_GROUP,info)              OVISCALC.212    
*ELSE                                                                      OVISCALC.213    
C Set up for non mpp code.                                                 OVISCALC.214    
      DO J = J_1, J_JMT                                                    OVISCALC.215    
         do i=1,imt                                                        OVISCALC.216    
            lscale(i,j)=lscale_global(i,j)                                 OVISCALC.217    
            tmin1(i,j)=tmin1_global(i,j)                                   OVISCALC.218    
          enddo                                                            OVISCALC.219    
      ENDDO                                                                OVISCALC.220    
*ENDIF                                                                     OVISCALC.221    
c Set the thickness diffusion coefficent.                                  OVISCALC.222    
c The length scale just calculated is the number of grid points            OVISCALC.223    
c multiplied by the length of each grid point so the length scale          OVISCALC.224    
c is now in centimetres.                                                   OVISCALC.225    
c The value 0.015 is given by Visbeck et. al.                              OVISCALC.226    
c The minimum and maximum allowed thickness diffusion is also set.         OVISCALC.227    
c (hardwired here at the moment)                                           OVISCALC.228    
c Reference: Visbeck, M. et al, On the specification of eddy               OVISCALC.229    
c            transfer coefficients in coarse resolution ocean              OVISCALC.230    
c            circulation models. J. Phys. Oceanogr.,27, p 381-402.         OVISCALC.231    
c                                                                          OVISCALC.232    
      if (L_OVISHADCM4) THEN                                               OVISCALC.233    
          athkdft_min=100.e4                                               OVISCALC.234    
      else                                                                 OVISCALC.235    
          athkdft_min=350.e4                                               OVISCALC.236    
      endif                                                                OVISCALC.237    
                                                                           OVISCALC.238    
      athkdft_max=2000.e4                                                  OVISCALC.239    
                                                                           OVISCALC.240    
      do j=j_1,j_jmt                                                       OVISCALC.241    
         do i=1,imt                                                        OVISCALC.242    
            ATHKDFT(i,j)=0.015*tmin1(i,j)*lscale(i,j)*lscale(i,j)          OVISCALC.243    
            if (ATHKDFT(i,j).lt.athkdft_min) ATHKDFT(i,j)=athkdft_min      OVISCALC.244    
            if (ATHKDFT(i,j).gt.athkdft_max) ATHKDFT(i,j)=athkdft_max      OVISCALC.245    
         enddo                                                             OVISCALC.246    
      enddo                                                                OVISCALC.247    
                                                                           OVISCALC.248    
      RETURN                                                               OVISCALC.249    
      END                                                                  OVISCALC.250    
*ENDIF                                                                     OVISCALC.251