libf/IOIPSL/ioipslmpp.f90

!$Header: /home/ioipsl/CVSROOT/IOIPSL/src/Attic/ioipslmpp.f90,v 2.0 2004/04/05 14:50:16 adm Exp $
!-
MODULE ioipslmpp
!---------------------------------------------------------------------
  USE errioipsl, ONLY : histerr
!-
  IMPLICIT NONE
!-
  PRIVATE
  PUBLIC :: ioipsl_inimpp, ioipslmpp_file, ioipslmpp_addatt
!-
  LOGICAL,SAVE :: ison_mpp=.FALSE., lock=.FALSE.
!-
! Number of distributed dimension for mpp
!-
  INTEGER,PARAMETER :: jpp=4
!-
  INTEGER,SAVE :: pe_number, pe_total_number
  INTEGER,SAVE,DIMENSION(jpp) :: &
 & domain_global_size, domain_local_size, domain_abs_first, &
 & domain_abs_last, domain_halo_start_size, domain_halo_end_size
!-
CONTAINS
!-
!===
!-
SUBROUTINE ioipsl_inimpp &
 & (petotnb, penb, pglo, ploc, pabsf, pabsl, phals, phale)
!---------------------------------------------------------------------
!- This routine sets up the MPP activity of IOIPSL.
!- It will store all the PE information and allow it to be stored
!- in the netCDF file and change the file names.
!-
!- INPUT
!-
!- penb    : process number
!- petotnb : total number of process
!- pglo(1) : total number of points in first direction
!- pglo(2) : total number of points in second direction
!- ploc(1) : local number of points in first direction
!- ploc(2) : local number of points in second direction
!- pabsf(1) : absolute position of first local point for
!-            first dimension
!- pabsf(2) : absolute position of first local point for
!-            second dimension
!- pabsl(1) : absolute position of last local point for
!-            first dimension
!- pabsl(2) : absolute position of last local point for
!-            second dimension
!- phals(1) : start halo size in first direction
!- phals(2) : start halo size in second direction
!- phale(1) : end halo size in first direction
!- phale(2) : end halo size in second direction
!- phale(2) : end halo size in second direction
!---------------------------------------------------------------------
  IMPLICIT NONE
!-
  INTEGER,INTENT(in) :: penb, petotnb
  INTEGER,DIMENSION(:),INTENT(in) :: &
 & pglo, ploc, pabsf, pabsl, phals, phale
!---------------------------------------------------------------------
  IF (lock) THEN
    CALL histerr (3,'ioipslmpp','ioipslmpp called to late', &
 &                'please call ioipslmpp before first histbeg','')
  ELSE
!-- Take note of the fact that we are on an MPP.
    ison_mpp=.TRUE.
!--
    pe_number = penb
    pe_total_number = petotnb
    domain_global_size(:) = pglo(:)
    domain_local_size(:) = ploc(:)
    domain_abs_first(:) = pabsf(:)
    domain_abs_last(:) = pabsl(:)
    domain_halo_start_size(:) = phals(:)
    domain_halo_end_size(:) = phale(:)
!-- Lock this information into the module
!-- so that it does not get changed
    lock = .TRUE.
  ENDIF
!---------------------------
END SUBROUTINE ioipsl_inimpp
!-
!===
!-
SUBROUTINE ioipslmpp_file (filename)
!---------------------------------------------------------------------
!- Update the netCDF file to include the PE number on which this
!- copy of IOIPSL runs.
!- This routine is called by histbeg and not by user anyway
!---------------------------------------------------------------------
  IMPLICIT NONE
!-
  CHARACTER(LEN=*),INTENT(inout) :: filename
!-
  INTEGER :: il
  CHARACTER(LEN=3) :: str
!---------------------------------------------------------------------
  IF (ison_mpp) THEN
    WRITE(str,'(I3.3)') pe_number
!-- Tester la taille de la chaine
    il = INDEX(filename,'.nc')
    filename = filename(1:il-1)//'_'//str//'.nc'
  ENDIF
!-
! This as to be done after ioipslmpp
!-
  lock = .TRUE.
!---------------------------------------------------------------------
END SUBROUTINE ioipslmpp_file
!-
!===
!-
SUBROUTINE ioipslmpp_addatt (fid)
!---------------------------------------------------------------------
!- Adds the attributed to the netCDF file.
!- This routine is called by histend and not by user anyway
!---------------------------------------------------------------------
  USE netcdf
!-
  IMPLICIT NONE
!-
  INTEGER,INTENT(in) :: fid
!-
  INTEGER :: iret
!---------------------------------------------------------------------
  IF (ison_mpp) THEN
    iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
 &      'PE_number',pe_number)
    iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
 &      'PE_total_number',pe_total_number)
    iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
 &      'DOMAIN_global_size',domain_global_size(1:jpp))
    iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
 &      'DOMAIN_local_size',domain_local_size(1:jpp))
    iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
 &      'DOMAIN_absolute_first_point_number',domain_abs_first(1:jpp))
    iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
 &      'DOMAIN_absolute_last_point_number',domain_abs_last(1:jpp))
    iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
 &      'DOMAIN_start_halo_size',domain_halo_start_size(1:jpp))
    iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
 &      'DOMAIN_end_halo_size',domain_halo_end_size(1:jpp))
  ENDIF
!-
! This as to be done after ioipslmpp
!-
  lock = .TRUE.
!------------------------------
END SUBROUTINE ioipslmpp_addatt
!-
!===
!-
END MODULE ioipslmpp
1	guez	30	!$Header: /home/ioipsl/CVSROOT/IOIPSL/src/Attic/ioipslmpp.f90,v 2.0 2004/04/05 14:50:16 adm Exp $
2			!-
3			MODULE ioipslmpp
4			!---------------------------------------------------------------------
5			USE errioipsl, ONLY : histerr
6			!-
7			IMPLICIT NONE
8			!-
9			PRIVATE
10			PUBLIC :: ioipsl_inimpp, ioipslmpp_file, ioipslmpp_addatt
11			!-
12			LOGICAL,SAVE :: ison_mpp=.FALSE., lock=.FALSE.
13			!-
14			! Number of distributed dimension for mpp
15			!-
16			INTEGER,PARAMETER :: jpp=4
17			!-
18			INTEGER,SAVE :: pe_number, pe_total_number
19			INTEGER,SAVE,DIMENSION(jpp) :: &
20			& domain_global_size, domain_local_size, domain_abs_first, &
21			& domain_abs_last, domain_halo_start_size, domain_halo_end_size
22			!-
23			CONTAINS
24			!-
25			!===
26			!-
27			SUBROUTINE ioipsl_inimpp &
28			& (petotnb, penb, pglo, ploc, pabsf, pabsl, phals, phale)
29			!---------------------------------------------------------------------
30			!- This routine sets up the MPP activity of IOIPSL.
31			!- It will store all the PE information and allow it to be stored
32			!- in the netCDF file and change the file names.
33			!-
34			!- INPUT
35			!-
36			!- penb : process number
37			!- petotnb : total number of process
38			!- pglo(1) : total number of points in first direction
39			!- pglo(2) : total number of points in second direction
40			!- ploc(1) : local number of points in first direction
41			!- ploc(2) : local number of points in second direction
42			!- pabsf(1) : absolute position of first local point for
43			!- first dimension
44			!- pabsf(2) : absolute position of first local point for
45			!- second dimension
46			!- pabsl(1) : absolute position of last local point for
47			!- first dimension
48			!- pabsl(2) : absolute position of last local point for
49			!- second dimension
50			!- phals(1) : start halo size in first direction
51			!- phals(2) : start halo size in second direction
52			!- phale(1) : end halo size in first direction
53			!- phale(2) : end halo size in second direction
54			!- phale(2) : end halo size in second direction
55			!---------------------------------------------------------------------
56			IMPLICIT NONE
57			!-
58			INTEGER,INTENT(in) :: penb, petotnb
59			INTEGER,DIMENSION(:),INTENT(in) :: &
60			& pglo, ploc, pabsf, pabsl, phals, phale
61			!---------------------------------------------------------------------
62			IF (lock) THEN
63			CALL histerr (3,'ioipslmpp','ioipslmpp called to late', &
64			& 'please call ioipslmpp before first histbeg','')
65			ELSE
66			!-- Take note of the fact that we are on an MPP.
67			ison_mpp=.TRUE.
68			!--
69			pe_number = penb
70			pe_total_number = petotnb
71			domain_global_size(:) = pglo(:)
72			domain_local_size(:) = ploc(:)
73			domain_abs_first(:) = pabsf(:)
74			domain_abs_last(:) = pabsl(:)
75			domain_halo_start_size(:) = phals(:)
76			domain_halo_end_size(:) = phale(:)
77			!-- Lock this information into the module
78			!-- so that it does not get changed
79			lock = .TRUE.
80			ENDIF
81			!---------------------------
82			END SUBROUTINE ioipsl_inimpp
83			!-
84			!===
85			!-
86			SUBROUTINE ioipslmpp_file (filename)
87			!---------------------------------------------------------------------
88			!- Update the netCDF file to include the PE number on which this
89			!- copy of IOIPSL runs.
90			!- This routine is called by histbeg and not by user anyway
91			!---------------------------------------------------------------------
92			IMPLICIT NONE
93			!-
94			CHARACTER(LEN=*),INTENT(inout) :: filename
95			!-
96			INTEGER :: il
97			CHARACTER(LEN=3) :: str
98			!---------------------------------------------------------------------
99			IF (ison_mpp) THEN
100			WRITE(str,'(I3.3)') pe_number
101			!-- Tester la taille de la chaine
102			il = INDEX(filename,'.nc')
103			filename = filename(1:il-1)//'_'//str//'.nc'
104			ENDIF
105			!-
106			! This as to be done after ioipslmpp
107			!-
108			lock = .TRUE.
109			!---------------------------------------------------------------------
110			END SUBROUTINE ioipslmpp_file
111			!-
112			!===
113			!-
114			SUBROUTINE ioipslmpp_addatt (fid)
115			!---------------------------------------------------------------------
116			!- Adds the attributed to the netCDF file.
117			!- This routine is called by histend and not by user anyway
118			!---------------------------------------------------------------------
119			USE netcdf
120			!-
121			IMPLICIT NONE
122			!-
123			INTEGER,INTENT(in) :: fid
124			!-
125			INTEGER :: iret
126			!---------------------------------------------------------------------
127			IF (ison_mpp) THEN
128			iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
129			& 'PE_number',pe_number)
130			iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
131			& 'PE_total_number',pe_total_number)
132			iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
133			& 'DOMAIN_global_size',domain_global_size(1:jpp))
134			iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
135			& 'DOMAIN_local_size',domain_local_size(1:jpp))
136			iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
137			& 'DOMAIN_absolute_first_point_number',domain_abs_first(1:jpp))
138			iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
139			& 'DOMAIN_absolute_last_point_number',domain_abs_last(1:jpp))
140			iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
141			& 'DOMAIN_start_halo_size',domain_halo_start_size(1:jpp))
142			iret = NF90_PUT_ATT (fid,NF90_GLOBAL, &
143			& 'DOMAIN_end_halo_size',domain_halo_end_size(1:jpp))
144			ENDIF
145			!-
146			! This as to be done after ioipslmpp
147			!-
148			lock = .TRUE.
149			!------------------------------
150			END SUBROUTINE ioipslmpp_addatt
151			!-
152			!===
153			!-
154			END MODULE ioipslmpp