pkg/smooth/smooth_init3d.F

0c3d35c9cd Gael*0001 #include "SMOOTH_OPTIONS.h"
                0002
9f5240b52a Jean*0003       SUBROUTINE SMOOTH_INIT3D( smoothOpNb, myThid )
0c3d35c9cd Gael*0004
                0005 C     *==========================================================*
                0006 C     | SUBROUTINE smooth_init3D
                0007 C     | o Routine that initializes one 3D smoothing/correlation operator
                0008 C     |   by computing/writing the corresponding diffusion operator
                0009 C     *==========================================================*
                0010
9f5240b52a Jean*0011 Cgf the choices of smooth3Dtype and smooth3Dsize need comments...
                0012 Cgf
                0013 Cgf smooth3DtypeH= 1) HORIZONTAL ALONG GRID AXIS
                0014 Cgf              2-3) GMREDI TYPES
                0015 Cgf                4) HORIZONTAL BUT WITH ROTATED AXIS
                0016 Cgf for now I focus on the simpler smooth3DtypeH=1 case
0c3d35c9cd Gael*0017
                0018       IMPLICIT NONE
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "GRID.h"
                0023 #include "SMOOTH.h"
                0024
9f5240b52a Jean*0025       INTEGER smoothOpNb
                0026       INTEGER myThid
                0027
                0028       INTEGER i, j, k, bi, bj
de57a2ec4b Mart*0029       CHARACTER*(MAX_LEN_FNAM) fnamegeneric
0c3d35c9cd Gael*0030       _RL smooth3D_KzMax
9f5240b52a Jean*0031
f9d7cbfb72 Ou W*0032       INTEGER IL
                0033
                0034 c     == functions ==
                0035       INTEGER  ILNBLNK
                0036       EXTERNAL ILNBLNK
                0037
                0038       IL = ILNBLNK( smoothDir )
                0039
9f5240b52a Jean*0040       smooth3DtotTime = smooth3Dnbt(smoothOpNb)*smooth3DdelTime
                0041
                0042 C vertical smoothing:
                0043
                0044       IF ( smooth3DsizeZ(smoothOpNb).EQ.3 ) THEN
f9d7cbfb72 Ou W*0045         WRITE(fnamegeneric,'(2A,I3.3)')
                0046      &        smoothDir(1:IL),
9f5240b52a Jean*0047      &        'smooth3DscalesZ', smoothOpNb
                0048         CALL READ_REC_3D_RL( fnamegeneric, smoothprec,
                0049      &                       Nr, smooth3D_Lz, 1, 1, myThid )
                0050         CALL EXCH_XYZ_RL( smooth3D_Lz, myThid )
                0051       ELSE
                0052         DO bj=myByLo(myThid),myByHi(myThid)
                0053          DO bi=myBxLo(myThid),myBxHi(myThid)
                0054           DO k=1,Nr
                0055            DO j=1-OLy,sNy+OLy
                0056             DO i=1-OLx,sNx+OLx
                0057              smooth3D_Lz(i,j,k,bi,bj) = smooth3D_Lz0(smoothOpNb)
                0058             ENDDO
                0059            ENDDO
0c3d35c9cd Gael*0060           ENDDO
                0061          ENDDO
                0062         ENDDO
9f5240b52a Jean*0063       ENDIF
0c3d35c9cd Gael*0064
9f5240b52a Jean*0065       DO bj=myByLo(myThid),myByHi(myThid)
                0066        DO bi=myBxLo(myThid),myBxHi(myThid)
0c3d35c9cd Gael*0067         DO k=1,Nr
                0068          DO j=1-OLy,sNy+OLy
                0069           DO i=1-OLx,sNx+OLx
9f5240b52a Jean*0070            smooth3D_kappaR(i,j,k,bi,bj) = smooth3D_Lz(i,j,k,bi,bj)
                0071      &             *smooth3D_Lz(i,j,k,bi,bj)/smooth3DtotTime/2
0c3d35c9cd Gael*0072           ENDDO
                0073          ENDDO
                0074         ENDDO
                0075        ENDDO
                0076       ENDDO
                0077
9f5240b52a Jean*0078 C avoid excessive vertical smoothing:
                0079       IF ( smooth3DsizeZ(smoothOpNb).NE.3 ) THEN
                0080         DO bj=myByLo(myThid),myByHi(myThid)
                0081          DO bi=myBxLo(myThid),myBxHi(myThid)
                0082           DO k=1,Nr
                0083            DO j=1-OLy,sNy+OLy
                0084             DO i=1-OLx,sNx+OLx
                0085              smooth3D_KzMax=drC(k)
                0086              smooth3D_KzMax = smooth3D_KzMax*smooth3D_KzMax
                0087      &                                      /smooth3DtotTime/2
                0088              IF ( smooth3D_kappaR(i,j,k,bi,bj).GT.smooth3D_KzMax ) THEN
                0089               smooth3D_kappaR(i,j,k,bi,bj) = smooth3D_KzMax
                0090              ENDIF
                0091             ENDDO
                0092            ENDDO
0c3d35c9cd Gael*0093           ENDDO
                0094          ENDDO
                0095         ENDDO
9f5240b52a Jean*0096       ENDIF
                0097
                0098       CALL EXCH_XYZ_RL( smooth3D_kappaR, myThid )
                0099
                0100 C horizontal smoothing:
                0101
                0102       IF ( smooth3DsizeH(smoothOpNb).EQ.3 ) THEN
f9d7cbfb72 Ou W*0103         WRITE(fnamegeneric,'(2A,I3.3)')
                0104      &        smoothDir(1:IL),
9f5240b52a Jean*0105      &        'smooth3DscalesH', smoothOpNb
                0106         CALL READ_REC_3D_RL( fnamegeneric, smoothprec,
                0107      &                       Nr, smooth3D_Lx, 1, 1, myThid )
                0108         CALL READ_REC_3D_RL( fnamegeneric, smoothprec,
                0109      &                       Nr, smooth3D_Ly, 2, 1, myThid )
                0110         CALL EXCH_XYZ_RL( smooth3D_Lx, myThid )
                0111         CALL EXCH_XYZ_RL( smooth3D_Ly, myThid )
                0112       ELSE
                0113         DO bj=myByLo(myThid),myByHi(myThid)
                0114          DO bi=myBxLo(myThid),myBxHi(myThid)
                0115           DO k=1,Nr
                0116            DO j=1-OLy,sNy+OLy
                0117             DO i=1-OLx,sNx+OLx
                0118              smooth3D_Lx(i,j,k,bi,bj) = smooth3D_Lx0(smoothOpNb)
                0119              smooth3D_Ly(i,j,k,bi,bj) = smooth3D_Ly0(smoothOpNb)
                0120             ENDDO
                0121            ENDDO
0c3d35c9cd Gael*0122           ENDDO
                0123          ENDDO
                0124         ENDDO
9f5240b52a Jean*0125       ENDIF
0c3d35c9cd Gael*0126
9f5240b52a Jean*0127       DO bj=myByLo(myThid),myByHi(myThid)
                0128        DO bi=myBxLo(myThid),myBxHi(myThid)
0c3d35c9cd Gael*0129         DO k=1,Nr
                0130          DO j=1-OLy,sNy+OLy
                0131           DO i=1-OLx,sNx+OLx
9f5240b52a Jean*0132            smooth3D_Kuy(i,j,k,bi,bj) = 0.
                0133            smooth3D_Kvx(i,j,k,bi,bj) = 0.
                0134            smooth3D_Kwx(i,j,k,bi,bj) = 0.
                0135            smooth3D_Kwy(i,j,k,bi,bj) = 0.
                0136            smooth3D_Kwz(i,j,k,bi,bj) = 0.
                0137            smooth3D_Kux(i,j,k,bi,bj) = smooth3D_Lx(i,j,k,bi,bj)
                0138      &              *smooth3D_Lx(i,j,k,bi,bj)/smooth3DtotTime/2
                0139            smooth3D_Kvy(i,j,k,bi,bj) = smooth3D_Ly(i,j,k,bi,bj)
                0140      &              *smooth3D_Ly(i,j,k,bi,bj)/smooth3DtotTime/2
                0141            smooth3D_Kuz(i,j,k,bi,bj) = 0.
                0142            smooth3D_Kvz(i,j,k,bi,bj) = 0.
0c3d35c9cd Gael*0143           ENDDO
                0144          ENDDO
                0145         ENDDO
                0146        ENDDO
                0147       ENDDO
                0148
9f5240b52a Jean*0149 C is exchange useful here?
                0150
                0151       CALL EXCH_XYZ_RL( smooth3D_kappaR, myThid )
                0152       CALL EXCH_XYZ_RL( smooth3D_Kwx, myThid )
                0153       CALL EXCH_XYZ_RL( smooth3D_Kwy, myThid )
                0154       CALL EXCH_XYZ_RL( smooth3D_Kwz, myThid )
                0155       CALL EXCH_XYZ_RL( smooth3D_Kux, myThid )
                0156       CALL EXCH_XYZ_RL( smooth3D_Kvy, myThid )
                0157       CALL EXCH_XYZ_RL( smooth3D_Kuz, myThid )
                0158       CALL EXCH_XYZ_RL( smooth3D_Kvz, myThid )
                0159       CALL EXCH_XYZ_RL( smooth3D_Kuy, myThid )
                0160       CALL EXCH_XYZ_RL( smooth3D_Kvx, myThid )
                0161
                0162 C write diffusion operator to file
                0163
f9d7cbfb72 Ou W*0164       WRITE(fnamegeneric,'(2A,I3.3)')
                0165      &      smoothDir(1:IL),
9f5240b52a Jean*0166      &      'smooth3Doperator', smoothOpNb
                0167       CALL WRITE_REC_3D_RL( fnamegeneric, smoothprec,
                0168      &                      Nr, smooth3D_Kwx, 1, 1, myThid )
                0169       CALL WRITE_REC_3D_RL( fnamegeneric, smoothprec,
                0170      &                      Nr, smooth3D_Kwy, 2, 1, myThid )
                0171       CALL WRITE_REC_3D_RL( fnamegeneric, smoothprec,
                0172      &                      Nr, smooth3D_Kwz, 3, 1, myThid )
                0173       CALL WRITE_REC_3D_RL( fnamegeneric, smoothprec,
                0174      &                      Nr, smooth3D_Kux, 4, 1, myThid )
                0175       CALL WRITE_REC_3D_RL( fnamegeneric, smoothprec,
                0176      &                      Nr, smooth3D_Kvy, 5, 1, myThid )
                0177       CALL WRITE_REC_3D_RL( fnamegeneric, smoothprec,
                0178      &                      Nr, smooth3D_Kuz, 6, 1, myThid )
                0179       CALL WRITE_REC_3D_RL( fnamegeneric, smoothprec,
                0180      &                      Nr, smooth3D_Kvz, 7, 1, myThid )
                0181       CALL WRITE_REC_3D_RL( fnamegeneric, smoothprec,
                0182      &                      Nr, smooth3D_Kuy, 8, 1, myThid )
                0183       CALL WRITE_REC_3D_RL( fnamegeneric, smoothprec,
                0184      &                      Nr, smooth3D_Kvx, 9, 1, myThid )
                0185       CALL WRITE_REC_3D_RL( fnamegeneric, smoothprec,
                0186      &                      Nr, smooth3D_kappaR, 10, 1, myThid )
                0187
                0188       RETURN
0c3d35c9cd Gael*0189       END