Changeset 14338 for NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_call_generic.h90
- Timestamp:
- 2021-01-25T08:50:49+01:00 (3 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_call_generic.h90
r14337 r14338 1 #if defined SINGLE_PRECISION 2 # if defined DIM_2d 3 # define ARRAY_TYPE(i,j,k,l) REAL(sp), DIMENSION(i,j) 4 # define PTR_TYPE TYPE(PTR_2D_sp) 5 # define PTR_ptab pt2d 6 # endif 7 # if defined DIM_3d 8 # define ARRAY_TYPE(i,j,k,l) REAL(sp), DIMENSION(i,j,k) 9 # define PTR_TYPE TYPE(PTR_3D_sp) 10 # define PTR_ptab pt3d 11 # endif 12 # if defined DIM_4d 13 # define ARRAY_TYPE(i,j,k,l) REAL(sp), DIMENSION(i,j,k,l) 14 # define PTR_TYPE TYPE(PTR_4D_sp) 15 # define PTR_ptab pt4d 16 # endif 17 # define PRECISION sp 18 #else 19 # if defined DIM_2d 20 # define ARRAY_TYPE(i,j,k,l) REAL(dp), DIMENSION(i,j) 21 # define PTR_TYPE TYPE(PTR_2D_dp) 22 # define PTR_ptab pt2d 23 # endif 24 # if defined DIM_3d 25 # define ARRAY_TYPE(i,j,k,l) REAL(dp), DIMENSION(i,j,k) 26 # define PTR_TYPE TYPE(PTR_3D_dp) 27 # define PTR_ptab pt3d 28 # endif 29 # if defined DIM_4d 30 # define ARRAY_TYPE(i,j,k,l) REAL(dp), DIMENSION(i,j,k,l) 31 # define PTR_TYPE TYPE(PTR_4D_dp) 32 # define PTR_ptab pt4d 33 # endif 34 # define PRECISION dp 1 #if defined DIM_2d 2 # define XD 2d 3 # define DIMS1 :,: 4 # define DIMS2 :,:,1,1 5 #endif 6 #if defined DIM_3d 7 # define XD 3d 8 # define DIMS1 :,:,: 9 # define DIMS2 :,:,:,1 10 #endif 11 #if defined DIM_4d 12 # define XD 4d 13 # define DIMS1 :,:,:,: 14 # define DIMS2 :,:,:,: 35 15 #endif 36 16 37 SUBROUTINE ROUTINE_MULTI( cdname & 38 & , pt1 , cdna1 , psgn1 , pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4 , cdna4 , psgn4 & 39 & , pt5 , cdna5 , psgn5 , pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8 , cdna8 , psgn8 & 40 & , pt9 , cdna9 , psgn9 , pt10, cdna10, psgn10, pt11, cdna11, psgn11, pt12, cdna12, psgn12 & 41 & , pt13, cdna13, psgn13, pt14, cdna14, psgn14, pt15, cdna15, psgn15, pt16, cdna16, psgn16 & 42 & , kfillmode, pfillval, lsend, lrecv, ncsten ) 17 SUBROUTINE lbc_lnk_call_/**/XD/**/_/**/PRECISION( & 18 & cdname & 19 & , pt1 , cdna1 , psgn1 , pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4 , cdna4 , psgn4 & 20 & , pt5 , cdna5 , psgn5 , pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8 , cdna8 , psgn8 & 21 & , pt9 , cdna9 , psgn9 , pt10, cdna10, psgn10, pt11, cdna11, psgn11, pt12, cdna12, psgn12 & 22 & , pt13, cdna13, psgn13, pt14, cdna14, psgn14, pt15, cdna15, psgn15, pt16, cdna16, psgn16 & 23 & , kfillmode, pfillval, lsend, lrecv, ncsten ) 43 24 !!--------------------------------------------------------------------- 44 25 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 45 ARRAY_TYPE(:,:,:,:) , TARGET, INTENT(inout) :: pt1! arrays on which the lbc is applied46 ARRAY_TYPE(:,:,:,:) , OPTIONAL, TARGET, INTENT(inout) :: pt2 , pt3 , pt4 , pt5 , pt6 , pt7 , pt8 , pt9, &47 & pt10 , pt11 , pt12 , pt13 , pt14 , pt15, pt1626 REAL(PRECISION), DIMENSION(DIMS1) , TARGET, INTENT(inout) :: pt1 ! arrays on which the lbc is applied 27 REAL(PRECISION), DIMENSION(DIMS1), OPTIONAL, TARGET, INTENT(inout) :: pt2 , pt3 , pt4 , pt5 , pt6 , pt7 , pt8 , pt9, & 28 & pt10, pt11, pt12, pt13, pt14, pt15, pt16 48 29 CHARACTER(len=1) , INTENT(in ) :: cdna1 ! nature of pt2D. array grid-points 49 30 CHARACTER(len=1) , OPTIONAL , INTENT(in ) :: cdna2 , cdna3 , cdna4 , cdna5 , cdna6 , cdna7 , cdna8 , cdna9, & … … 58 39 !! 59 40 INTEGER :: kfld ! number of elements that will be attributed 60 PTR_TYPE, DIMENSION(16) :: ptab_ptr ! pointer array41 TYPE(PTR_/**/XD/**/_/**/PRECISION), DIMENSION(16) :: ptab_ptr ! pointer array 61 42 CHARACTER(len=1) , DIMENSION(16) :: cdna_ptr ! nature of ptab_ptr grid-points 62 43 REAL(PRECISION) , DIMENSION(16) :: psgn_ptr ! sign used across the north fold boundary … … 66 47 ! 67 48 ! ! Load the first array 68 CALL ROUTINE_LOAD( pt1, cdna1, psgn1, ptab_ptr, cdna_ptr, psgn_ptr, kfld )49 CALL load_ptr_/**/XD/**/_/**/PRECISION( pt1, cdna1, psgn1, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 69 50 ! 70 51 ! ! Look if more arrays are added 71 IF( PRESENT(psgn2 ) ) CALL ROUTINE_LOAD( pt2 , cdna2 , psgn2 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )72 IF( PRESENT(psgn3 ) ) CALL ROUTINE_LOAD( pt3 , cdna3 , psgn3 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )73 IF( PRESENT(psgn4 ) ) CALL ROUTINE_LOAD( pt4 , cdna4 , psgn4 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )74 IF( PRESENT(psgn5 ) ) CALL ROUTINE_LOAD( pt5 , cdna5 , psgn5 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )75 IF( PRESENT(psgn6 ) ) CALL ROUTINE_LOAD( pt6 , cdna6 , psgn6 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )76 IF( PRESENT(psgn7 ) ) CALL ROUTINE_LOAD( pt7 , cdna7 , psgn7 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )77 IF( PRESENT(psgn8 ) ) CALL ROUTINE_LOAD( pt8 , cdna8 , psgn8 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )78 IF( PRESENT(psgn9 ) ) CALL ROUTINE_LOAD( pt9 , cdna9 , psgn9 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )79 IF( PRESENT(psgn10) ) CALL ROUTINE_LOAD( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld )80 IF( PRESENT(psgn11) ) CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld )81 IF( PRESENT(psgn12) ) CALL ROUTINE_LOAD( pt12, cdna12, psgn12, ptab_ptr, cdna_ptr, psgn_ptr, kfld )82 IF( PRESENT(psgn13) ) CALL ROUTINE_LOAD( pt13, cdna13, psgn13, ptab_ptr, cdna_ptr, psgn_ptr, kfld )83 IF( PRESENT(psgn14) ) CALL ROUTINE_LOAD( pt14, cdna14, psgn14, ptab_ptr, cdna_ptr, psgn_ptr, kfld )84 IF( PRESENT(psgn15) ) CALL ROUTINE_LOAD( pt15, cdna15, psgn15, ptab_ptr, cdna_ptr, psgn_ptr, kfld )85 IF( PRESENT(psgn16) ) CALL ROUTINE_LOAD( pt16, cdna16, psgn16, ptab_ptr, cdna_ptr, psgn_ptr, kfld )52 IF( PRESENT(psgn2 ) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt2 , cdna2 , psgn2 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 53 IF( PRESENT(psgn3 ) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt3 , cdna3 , psgn3 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 54 IF( PRESENT(psgn4 ) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt4 , cdna4 , psgn4 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 55 IF( PRESENT(psgn5 ) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt5 , cdna5 , psgn5 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 56 IF( PRESENT(psgn6 ) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt6 , cdna6 , psgn6 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 57 IF( PRESENT(psgn7 ) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt7 , cdna7 , psgn7 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 58 IF( PRESENT(psgn8 ) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt8 , cdna8 , psgn8 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 59 IF( PRESENT(psgn9 ) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt9 , cdna9 , psgn9 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 60 IF( PRESENT(psgn10) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 61 IF( PRESENT(psgn11) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 62 IF( PRESENT(psgn12) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt12, cdna12, psgn12, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 63 IF( PRESENT(psgn13) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt13, cdna13, psgn13, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 64 IF( PRESENT(psgn14) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt14, cdna14, psgn14, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 65 IF( PRESENT(psgn15) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt15, cdna15, psgn15, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 66 IF( PRESENT(psgn16) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt16, cdna16, psgn16, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 86 67 ! 87 CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 68 IF( nn_comm == 1 ) THEN 69 CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv ) 70 ELSE 71 CALL lbc_lnk_neicoll( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 72 ENDIF 88 73 ! 89 END SUBROUTINE ROUTINE_MULTI74 END SUBROUTINE lbc_lnk_call_/**/XD/**/_/**/PRECISION 90 75 91 76 92 SUBROUTINE ROUTINE_LOAD( ptab, cdna, psgn, ptab_ptr, cdna_ptr, psgn_ptr, kfld )77 SUBROUTINE load_ptr_/**/XD/**/_/**/PRECISION( ptab, cdna, psgn, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 93 78 !!--------------------------------------------------------------------- 94 ARRAY_TYPE(:,:,:,:), TARGET, INTENT(inout) :: ptab ! arrays on which the lbc is applied79 REAL(PRECISION), DIMENSION(DIMS1), TARGET, INTENT(inout) :: ptab ! arrays on which the lbc is applied 95 80 CHARACTER(len=1) , INTENT(in ) :: cdna ! nature of pt2d array grid-points 96 81 REAL(PRECISION) , INTENT(in ) :: psgn ! sign used across the north fold boundary 97 PTR_TYPE, DIMENSION(:), INTENT(inout) :: ptab_ptr ! array of pointers82 TYPE(PTR_/**/XD/**/_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab_ptr ! array of pointers 98 83 CHARACTER(len=1), DIMENSION(:), INTENT(inout) :: cdna_ptr ! nature of pt2d_array array grid-points 99 84 REAL(PRECISION) , DIMENSION(:), INTENT(inout) :: psgn_ptr ! sign used across the north fold boundary … … 102 87 ! 103 88 kfld = kfld + 1 104 ptab_ptr(kfld)% PTR_ptab=> ptab89 ptab_ptr(kfld)%pt/**/XD => ptab 105 90 cdna_ptr(kfld) = cdna 106 91 psgn_ptr(kfld) = psgn 107 92 ! 108 END SUBROUTINE ROUTINE_LOAD93 END SUBROUTINE load_ptr_/**/XD/**/_/**/PRECISION 109 94 110 #undef PRECISION 111 #undef ARRAY_TYPE 112 #undef PTR_TYPE 113 #undef PTR_ptab 95 #undef XD 96 #undef DIMS1 97 #undef DIMS2
Note: See TracChangeset
for help on using the changeset viewer.
