Back to home page

MITgcm

 
 

    


File indexing completed on 2023-07-14 05:10:51 UTC

view on githubraw file Latest commit de57a2ec on 2023-07-13 16:55:13 UTC
0c3d35c9cd Gael*0001 #include "SMOOTH_OPTIONS.h"
                0002 
9f5240b52a Jean*0003       SUBROUTINE SMOOTH_CORREL3D(
                0004      &           fld_in, smoothOpNb, myThid )
0c3d35c9cd Gael*0005 
                0006 C     *==========================================================*
                0007 C     | SUBROUTINE smooth_correl3D
9f5240b52a Jean*0008 C     | o Routine that applies spatial correlation
0c3d35c9cd Gael*0009 C     |   operator to a 3D control field
                0010 C     *==========================================================*
                0011 
                0012       IMPLICIT NONE
                0013 #include "SIZE.h"
                0014 #include "EEPARAMS.h"
                0015 #include "GRID.h"
                0016 #include "PARAMS.h"
                0017 #include "SMOOTH.h"
                0018 
9f5240b52a Jean*0019       _RL fld_in(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0020       INTEGER smoothOpNb
                0021       INTEGER myThid
0c3d35c9cd Gael*0022 
9f5240b52a Jean*0023       INTEGER nbt_in
de57a2ec4b Mart*0024       CHARACTER*(MAX_LEN_FNAM) fnamegeneric
9f5240b52a Jean*0025       INTEGER i,j,k,bi,bj
f9d7cbfb72 Ou W*0026       INTEGER IL
                0027 
                0028 c     == functions ==
                0029       INTEGER  ILNBLNK
                0030       EXTERNAL ILNBLNK
                0031 
                0032       IL = ILNBLNK( smoothDir )
0c3d35c9cd Gael*0033 
                0034 c read smoothing [i.e diffusion] operator:
f9d7cbfb72 Ou W*0035       WRITE(fnamegeneric,'(2A,I3.3)')
                0036      &      smoothDir(1:IL),
9f5240b52a Jean*0037      &      'smooth3Doperator', smoothOpNb
                0038       CALL READ_REC_3D_RL( fnamegeneric, smoothprec,
                0039      &           Nr, smooth3D_Kwx, 1, 1, myThid )
                0040       CALL READ_REC_3D_RL( fnamegeneric, smoothprec,
                0041      &           Nr, smooth3D_Kwy, 2, 1, myThid )
                0042       CALL READ_REC_3D_RL( fnamegeneric, smoothprec,
                0043      &           Nr, smooth3D_Kwz, 3, 1, myThid )
                0044       CALL READ_REC_3D_RL( fnamegeneric, smoothprec,
                0045      &           Nr, smooth3D_Kux, 4, 1, myThid )
                0046       CALL READ_REC_3D_RL( fnamegeneric, smoothprec,
                0047      &           Nr, smooth3D_Kvy, 5, 1, myThid )
                0048       CALL READ_REC_3D_RL( fnamegeneric, smoothprec,
                0049      &           Nr, smooth3D_Kuz, 6, 1, myThid )
                0050       CALL READ_REC_3D_RL( fnamegeneric, smoothprec,
                0051      &           Nr, smooth3D_Kvz, 7, 1, myThid )
                0052       CALL READ_REC_3D_RL( fnamegeneric, smoothprec,
                0053      &           Nr, smooth3D_Kuy, 8, 1, myThid )
                0054       CALL READ_REC_3D_RL( fnamegeneric, smoothprec,
                0055      &           Nr, smooth3D_Kvx, 9, 1, myThid )
                0056       CALL READ_REC_3D_RL( fnamegeneric, smoothprec,
                0057      &           Nr, smooth3D_kappaR, 10, 1, myThid )
                0058       CALL EXCH_XYZ_RL( smooth3D_Kwx, myThid )
                0059       CALL EXCH_XYZ_RL( smooth3D_Kwy, myThid )
                0060       CALL EXCH_XYZ_RL( smooth3D_Kwz, myThid )
                0061       CALL EXCH_XYZ_RL( smooth3D_Kux, myThid )
                0062       CALL EXCH_XYZ_RL( smooth3D_Kvy, myThid )
                0063       CALL EXCH_XYZ_RL( smooth3D_Kuz, myThid )
                0064       CALL EXCH_XYZ_RL( smooth3D_Kvz, myThid )
                0065       CALL EXCH_XYZ_RL( smooth3D_Kuy, myThid )
                0066       CALL EXCH_XYZ_RL( smooth3D_Kvx, myThid )
                0067       CALL EXCH_XYZ_RL( smooth3D_kappaR, myThid )
0c3d35c9cd Gael*0068 
                0069 c read normalization field [i.e. 1/sqrt(var(filter))]:
f9d7cbfb72 Ou W*0070       WRITE(fnamegeneric,'(2A,I3.3)')
                0071      &      smoothDir(1:IL),
9f5240b52a Jean*0072      &      'smooth3Dnorm', smoothOpNb
                0073       CALL READ_REC_3D_RL( fnamegeneric, smoothprec,
                0074      &           Nr, smooth3Dnorm, 1, 1, myThid)
                0075       CALL EXCH_XYZ_RL( smooth3Dnorm, myThid )
0c3d35c9cd Gael*0076 
                0077 c division by ~sqrt(volume):
9f5240b52a Jean*0078       DO bj=myByLo(myThid),myByHi(myThid)
                0079        DO bi=myBxLo(myThid),myBxHi(myThid)
0c3d35c9cd Gael*0080         DO k=1,Nr
                0081          DO j=1,sNy
9f5240b52a Jean*0082           DO i=1,sNx
                0083            fld_in(i,j,k,bi,bj) = fld_in(i,j,k,bi,bj)
                0084      &          *SQRT(recip_rA(i,j,bi,bj)*recip_drF(k))
0c3d35c9cd Gael*0085           ENDDO
                0086          ENDDO
                0087         ENDDO
                0088        ENDDO
                0089       ENDDO
9f5240b52a Jean*0090       CALL EXCH_XYZ_RL( fld_in, myThid )
0c3d35c9cd Gael*0091 
                0092 c do the smoothing:
9f5240b52a Jean*0093       nbt_in = smooth3Dnbt(smoothOpNb)/2
                0094       CALL smooth_diff3D( fld_in, nbt_in, myThid )
0c3d35c9cd Gael*0095 
                0096 c division by ~sqrt(var(filter)):
9f5240b52a Jean*0097       DO bj=myByLo(myThid),myByHi(myThid)
                0098        DO bi=myBxLo(myThid),myBxHi(myThid)
                0099         DO j = 1,sNy
                0100          DO i = 1,sNx
                0101           DO k = 1,Nr
                0102            fld_in(i,j,k,bi,bj) = fld_in(i,j,k,bi,bj)
                0103      &                          *smooth3Dnorm(i,j,k,bi,bj)
0c3d35c9cd Gael*0104           ENDDO
                0105          ENDDO
                0106         ENDDO
                0107        ENDDO
9f5240b52a Jean*0108       ENDDO
                0109       CALL EXCH_XYZ_RL( fld_in, myThid )
0c3d35c9cd Gael*0110 
9f5240b52a Jean*0111       RETURN
                0112       END