[8] | 1 | ! Yann Meurdesoif functions for parallel tests. |
---|
| 2 | |
---|
| 3 | !- |
---|
| 4 | !- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/orch_write_field_p.f90,v 1.3 2007/09/21 14:13:21 ssipsl Exp $ |
---|
| 5 | !- |
---|
| 6 | |
---|
| 7 | MODULE Orch_Write_field_p |
---|
| 8 | |
---|
| 9 | interface WriteField_p |
---|
| 10 | module procedure WriteField_4d_p,WriteField_3d_p,WriteField_2d_p |
---|
| 11 | end interface WriteField_p |
---|
| 12 | |
---|
| 13 | interface WriteFieldI_p |
---|
| 14 | module procedure WriteFieldI_3d_p,WriteFieldI_2d_p,WriteFieldI_1d_p |
---|
| 15 | end interface WriteFieldI_p |
---|
| 16 | |
---|
| 17 | |
---|
| 18 | CONTAINS |
---|
| 19 | |
---|
| 20 | SUBROUTINE init_WriteField_p(index_Write_Field_p) |
---|
| 21 | USE parallel |
---|
| 22 | USE Write_Field, only : Init_WriteField |
---|
| 23 | IMPLICIT NONE |
---|
| 24 | INTEGER,INTENT(in) :: index_Write_Field_p(nbp_loc) |
---|
| 25 | |
---|
| 26 | IF (is_root_prc) CALL Init_WriteField(iim_g,jjm_g,nbp_glo,index_g) |
---|
| 27 | |
---|
| 28 | END SUBROUTINE init_WriteField_p |
---|
| 29 | |
---|
| 30 | SUBROUTINE WriteField_4d_p(name,Field) |
---|
| 31 | USE parallel |
---|
| 32 | USE Write_field, only : WriteField |
---|
| 33 | IMPLICIT NONE |
---|
| 34 | CHARACTER(len=*) :: name |
---|
| 35 | REAL, DIMENSION(:,:,:,:) :: Field |
---|
| 36 | INTEGER, DIMENSION(4) :: Dim |
---|
| 37 | |
---|
| 38 | REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: Field_g |
---|
| 39 | |
---|
| 40 | |
---|
| 41 | Dim=shape(Field) |
---|
| 42 | |
---|
| 43 | ALLOCATE(Field_g(iim_g,jjm_g,Dim(3),Dim(4))) |
---|
| 44 | CALL Gather2D(Field,Field_g) |
---|
| 45 | |
---|
| 46 | IF (is_root_prc) CALL WriteField(name,Field_g) |
---|
| 47 | |
---|
| 48 | DEALLOCATE(Field_g) |
---|
| 49 | END SUBROUTINE WriteField_4d_p |
---|
| 50 | |
---|
| 51 | SUBROUTINE WriteField_3d_p(name,Field) |
---|
| 52 | USE parallel |
---|
| 53 | USE Write_field, only : WriteField |
---|
| 54 | IMPLICIT NONE |
---|
| 55 | CHARACTER(len=*) :: name |
---|
| 56 | REAL, DIMENSION(:,:,:) :: Field |
---|
| 57 | INTEGER, DIMENSION(3) :: Dim |
---|
| 58 | |
---|
| 59 | REAL, ALLOCATABLE, DIMENSION(:,:,:) :: Field_g |
---|
| 60 | |
---|
| 61 | |
---|
| 62 | Dim=shape(Field) |
---|
| 63 | |
---|
| 64 | ALLOCATE(Field_g(iim_g,jjm_g,Dim(3))) |
---|
| 65 | CALL Gather2D(Field,Field_g) |
---|
| 66 | |
---|
| 67 | IF (is_root_prc) CALL WriteField(name,Field_g) |
---|
| 68 | |
---|
| 69 | DEALLOCATE(Field_g) |
---|
| 70 | END SUBROUTINE WriteField_3d_p |
---|
| 71 | |
---|
| 72 | SUBROUTINE WriteField_2d_p(name,Field) |
---|
| 73 | USE parallel |
---|
| 74 | USE Write_field, only : WriteField |
---|
| 75 | IMPLICIT NONE |
---|
| 76 | CHARACTER(len=*) :: name |
---|
| 77 | REAL, DIMENSION(:,:) :: Field |
---|
| 78 | INTEGER, DIMENSION(2) :: Dim |
---|
| 79 | |
---|
| 80 | REAL, ALLOCATABLE, DIMENSION(:,:) :: Field_g |
---|
| 81 | |
---|
| 82 | |
---|
| 83 | Dim=shape(Field) |
---|
| 84 | |
---|
| 85 | ALLOCATE(Field_g(iim_g,jjm_g)) |
---|
| 86 | CALL Gather2D(Field,Field_g) |
---|
| 87 | |
---|
| 88 | IF (is_root_prc) CALL WriteField_gen(name,Field_g) |
---|
| 89 | |
---|
| 90 | DEALLOCATE(Field_g) |
---|
| 91 | END SUBROUTINE WriteField_2d_p |
---|
| 92 | |
---|
| 93 | SUBROUTINE WriteFieldI_3d_p(name,Field) |
---|
| 94 | USE parallel |
---|
| 95 | USE Write_field, only : WriteFieldI |
---|
| 96 | IMPLICIT NONE |
---|
| 97 | CHARACTER(len=*) :: name |
---|
| 98 | REAL, DIMENSION(:,:,:) :: Field |
---|
| 99 | INTEGER, DIMENSION(3) :: Dim |
---|
| 100 | |
---|
| 101 | REAL, ALLOCATABLE, DIMENSION(:,:,:) :: Field_g |
---|
| 102 | |
---|
| 103 | |
---|
| 104 | Dim=shape(Field) |
---|
| 105 | |
---|
| 106 | ALLOCATE(Field_g(nbp_glo,Dim(2),Dim(3))) |
---|
| 107 | CALL gather(Field,Field_g) |
---|
| 108 | |
---|
| 109 | IF (is_root_prc) CALL WriteFieldI(name,Field_g) |
---|
| 110 | |
---|
| 111 | DEALLOCATE(Field_g) |
---|
| 112 | END SUBROUTINE WriteFieldI_3d_p |
---|
| 113 | |
---|
| 114 | SUBROUTINE WriteFieldI_2d_p(name,Field) |
---|
| 115 | USE parallel |
---|
| 116 | USE Write_field, only : WriteFieldI |
---|
| 117 | IMPLICIT NONE |
---|
| 118 | CHARACTER(len=*) :: name |
---|
| 119 | REAL, DIMENSION(:,:) :: Field |
---|
| 120 | INTEGER, DIMENSION(2) :: Dim |
---|
| 121 | |
---|
| 122 | REAL, ALLOCATABLE, DIMENSION(:,:) :: Field_g |
---|
| 123 | |
---|
| 124 | |
---|
| 125 | Dim=shape(Field) |
---|
| 126 | |
---|
| 127 | ALLOCATE(Field_g(nbp_glo,Dim(2))) |
---|
| 128 | CALL gather(Field,Field_g) |
---|
| 129 | |
---|
| 130 | IF (is_root_prc) CALL WriteFieldI(name,Field_g) |
---|
| 131 | |
---|
| 132 | DEALLOCATE(Field_g) |
---|
| 133 | END SUBROUTINE WriteFieldI_2d_p |
---|
| 134 | |
---|
| 135 | SUBROUTINE WriteFieldI_1d_p(name,Field) |
---|
| 136 | USE parallel |
---|
| 137 | USE Write_field, only : WriteFieldI |
---|
| 138 | IMPLICIT NONE |
---|
| 139 | CHARACTER(len=*) :: name |
---|
| 140 | REAL, DIMENSION(:) :: Field |
---|
| 141 | INTEGER, DIMENSION(1) :: Dim |
---|
| 142 | |
---|
| 143 | REAL, ALLOCATABLE, DIMENSION(:) :: Field_g |
---|
| 144 | |
---|
| 145 | |
---|
| 146 | Dim=shape(Field) |
---|
| 147 | |
---|
| 148 | ALLOCATE(Field_g(nbp_glo)) |
---|
| 149 | CALL gather(Field,Field_g) |
---|
| 150 | |
---|
| 151 | IF (is_root_prc) CALL WriteFieldI(name,Field_g) |
---|
| 152 | |
---|
| 153 | DEALLOCATE(Field_g) |
---|
| 154 | END SUBROUTINE WriteFieldI_1d_p |
---|
| 155 | |
---|
| 156 | END MODULE Orch_Write_field_p |
---|