Changeset 6004 for branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
- Timestamp:
- 2015-12-04T17:05:58+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
r5845 r6004 1 1 MODULE crslbclnk 2 3 2 !!====================================================================== 4 3 !! *** MODULE crslbclnk *** … … 8 7 !! History : ! 2012-06 (J. Simeon, G. Madec, C. Ethe, C. Calone) Original code 9 8 !!---------------------------------------------------------------------- 9 USE par_kind, ONLY: wp 10 10 USE dom_oce 11 11 USE crs 12 ! 12 13 USE lbclnk 13 USE par_kind, ONLY: wp14 14 USE in_out_manager 15 15 … … 37 37 !! Upon exiting, switch back to full domain indices. 38 38 !!---------------------------------------------------------------------- 39 CHARACTER(len=1) , INTENT(in ) :: cd_type1 ! grid type 40 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 41 42 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: pt3d1 ! 3D array on which the lbc is applied 43 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! valeur sur les halo 44 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 39 CHARACTER(len=1) , INTENT(in ) :: cd_type1 ! grid type 40 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 41 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: pt3d1 ! 3D array on which the lbc is applied 42 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! valeur sur les halo 43 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! MPP only (here do nothing) 45 44 ! 46 LOGICAL 47 REAL(wp) :: zval! valeur sur les halo45 LOGICAL :: ll_grid_crs 46 REAL(wp) :: zval ! valeur sur les halo 48 47 !!---------------------------------------------------------------------- 49 48 ! 50 49 ll_grid_crs = ( jpi == jpi_crs ) 51 50 ! 52 51 IF( PRESENT(pval) ) THEN ; zval = pval 53 ELSE ; zval = 0. 052 ELSE ; zval = 0._wp 54 53 ENDIF 55 56 IF( .NOT. 57 54 ! 55 IF( .NOT.ll_grid_crs ) CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 56 ! 58 57 IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval ) 59 58 ELSE ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval ) 60 59 ENDIF 61 62 IF( .NOT. 63 60 ! 61 IF( .NOT.ll_grid_crs ) CALL dom_grid_glo ! Return to parent grid domain 62 ! 64 63 END SUBROUTINE crs_lbc_lnk_3d 64 65 65 66 66 SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) … … 74 74 !! Upon exiting, switch back to full domain indices. 75 75 !!---------------------------------------------------------------------- 76 !! Arguments 77 CHARACTER(len=1) , INTENT(in ) :: cd_type1,cd_type2 ! grid type 78 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 79 80 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: pt3d1,pt3d2 ! 3D array on which the lbc is applied 81 82 !! local vairables 83 LOGICAL :: ll_grid_crs 76 CHARACTER(len=1) , INTENT(in ) :: cd_type1, cd_type2 ! grid type 77 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 78 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: pt3d1 , pt3d2 ! 3D array on which the lbc is applied 79 ! 80 LOGICAL :: ll_grid_crs 84 81 !!---------------------------------------------------------------------- 85 82 ! 86 83 ll_grid_crs = ( jpi == jpi_crs ) 87 88 IF( .NOT. 89 84 ! 85 IF( .NOT.ll_grid_crs ) CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 86 ! 90 87 CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 91 92 IF( .NOT. 93 88 ! 89 IF( .NOT.ll_grid_crs ) CALL dom_grid_glo ! Return to parent grid domain 90 ! 94 91 END SUBROUTINE crs_lbc_lnk_3d_gather 95 92 … … 106 103 !! Upon exiting, switch back to full domain indices. 107 104 !!---------------------------------------------------------------------- 108 !! Arguments 109 CHARACTER(len=1) , INTENT(in ) :: cd_type ! grid type 110 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 111 112 REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied 113 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! valeur sur les halo 114 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 115 !! local variables 116 117 LOGICAL :: ll_grid_crs 118 REAL(wp) :: zval ! valeur sur les halo 119 105 CHARACTER(len=1) , INTENT(in ) :: cd_type ! grid type 106 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 107 REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied 108 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! valeur sur les halo 109 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! MPP only (here do nothing) 110 ! 111 LOGICAL :: ll_grid_crs 112 REAL(wp) :: zval ! valeur sur les halo 120 113 !!---------------------------------------------------------------------- 121 114 ! 122 115 ll_grid_crs = ( jpi == jpi_crs ) 123 116 ! 124 117 IF( PRESENT(pval) ) THEN ; zval = pval 125 ELSE ; zval = 0. 0118 ELSE ; zval = 0._wp 126 119 ENDIF 127 128 IF( .NOT. 129 120 ! 121 IF( .NOT.ll_grid_crs ) CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 122 ! 130 123 IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval ) 131 124 ELSE ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval ) 132 125 ENDIF 133 134 IF( .NOT. 135 126 ! 127 IF( .NOT.ll_grid_crs ) CALL dom_grid_glo ! Return to parent grid domain 128 ! 136 129 END SUBROUTINE crs_lbc_lnk_2d 137 130 138 131 !!====================================================================== 139 132 END MODULE crslbclnk
Note: See TracChangeset
for help on using the changeset viewer.