New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
mod_field_bufferize.f90 in vendors/XMLIO_SERVER/current/src/IOSERVER – NEMO

source: vendors/XMLIO_SERVER/current/src/IOSERVER/mod_field_bufferize.f90 @ 1897

Last change on this file since 1897 was 1897, checked in by flavoni, 14 years ago

importing XMLIO_SERVER vendor

File size: 2.0 KB
Line 
1MODULE field_bufferize
2 
3  INTEGER,SAVE      :: nx=0
4  INTEGER,SAVE      :: ny=0
5  INTEGER,SAVE      :: nz=0
6   
7  REAL,POINTER,SAVE :: field_buffer(:,:,:)
8 
9
10 
11CONTAINS
12
13  SUBROUTINE bufferize_field(ni,ibegin,nj,jbegin,nk,kbegin,nbp,field,i_index,j_index,mask)
14  IMPLICIT NONE
15    INTEGER,INTENT(IN) :: ni
16    INTEGER,INTENT(IN) :: ibegin
17    INTEGER,INTENT(IN) :: nj
18    INTEGER,INTENT(IN) :: jbegin
19    INTEGER,INTENT(IN) :: nk
20    INTEGER,INTENT(IN) :: kbegin
21    INTEGER,INTENT(IN) :: nbp
22    REAL,INTENT(IN)    :: field(nbp,nk)
23    INTEGER,INTENT(IN) :: i_index(nbp)
24    INTEGER,INTENT(IN) :: j_index(nbp)
25    LOGICAL,INTENT(IN),OPTIONAL :: mask(nbp) 
26   
27    INTEGER :: iend
28    INTEGER :: jend
29    INTEGER :: kend 
30
31    LOGICAL      :: need_reallocate
32    REAL,POINTER :: tmp_buffer(:,:,:)
33    INTEGER      :: i,j,k,n
34   
35    iend=ibegin+ni-1
36    jend=jbegin+nj-1
37    kend=kbegin+nk-1
38   
39    IF (PRESENT(mask)) THEN
40      DO k=kbegin,kend
41        DO n=1,nbp
42          i=i_index(n)+ibegin-1
43          j=j_index(n)+jbegin-1
44          IF (mask(n)) field_buffer(i,j,k)=field(n,k)
45        ENDDO
46      ENDDO
47    ELSE
48      DO k=kbegin,kend
49        DO n=1,nbp
50          i=i_index(n)+ibegin-1
51          j=j_index(n)+jbegin-1
52          field_buffer(i,j,k)=field(n,k)
53        ENDDO
54      ENDDO
55    ENDIF
56   
57  END SUBROUTINE bufferize_field
58
59  SUBROUTINE Init_field_Bufferize(ni,nj,nk)
60  IMPLICIT NONE
61  INTEGER,INTENT(IN) :: ni
62  INTEGER,INTENT(IN) :: nj
63  INTEGER,INTENT(IN) :: nk
64     
65    LOGICAL :: need_reallocate
66   
67   
68    need_reallocate=.FALSE.
69   
70    IF ( ni > nx) THEN
71      nx=ni
72      need_reallocate=.TRUE.
73    ENDIF
74   
75    IF ( nj > ny) THEN
76      ny=nj
77      need_reallocate=.TRUE.
78    ENDIF
79
80    IF ( nk > nz) THEN
81      nz=nk
82      need_reallocate=.TRUE.
83    ENDIF
84   
85    IF (need_reallocate) THEN
86      IF (ASSOCIATED(field_buffer)) DEALLOCATE(field_buffer)
87      ALLOCATE(field_buffer(nx,ny,nz))
88    ENDIF
89
90    field_buffer(1:nx,1:ny,1:nz)=0.
91
92  END SUBROUTINE  init_field_bufferize         
93
94END MODULE field_bufferize
Note: See TracBrowser for help on using the repository browser.