74 USE modi_error_read_surf_fa
76 USE yomhook
,ONLY : lhook, dr_hook
77 USE parkind1
,ONLY : jprb
81 LOGICAL,
INTENT(OUT) :: onew
83 LOGICAL :: gold, gwork
84 INTEGER :: ingrib, inbits, istron, ipuila, iresp
86 REAL(KIND=JPRB) :: zhook_handle
88 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:SFX_FA_VERSION',0,zhook_handle)
92 CALL fanion(iresp,nunit_fa,cprefix1d,0,
'VERSION',onew,gwork,ingrib,inbits,istron,ipuila)
95 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:SFX_FA_VERSION',1,zhook_handle)
103 hrec,pfield,kresp,hcomment)
118 USE modi_error_read_surf_fa
120 USE yomhook
,ONLY : lhook, dr_hook
121 USE parkind1
,ONLY : jprb
129 CHARACTER(LEN=*),
INTENT(IN) :: hrec
130 REAL,
INTENT(OUT) :: pfield
131 INTEGER,
INTENT(OUT) :: kresp
132 CHARACTER(LEN=100),
INTENT(OUT) :: hcomment
136 CHARACTER(LEN=50) :: ycomment
137 CHARACTER(LEN=6) :: ymask
138 CHARACTER(LEN=18) :: yname
141 REAL(KIND=JPRB) :: zhook_handle
143 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFX0_FA',0,zhook_handle)
152 yname=cprefix1d//trim(hrec)
155 IF (lwork0) ymask=
'FULL '
156 yname=trim(ymask)//trim(hrec)
159 CALL
falit_r(kresp,nunit_fa,yname,pfield)
162 ycomment = trim(yname)
165 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFX0_FA',1,zhook_handle)
179 USE modd_surfex_mpi, ONLY : nrank, nproc, ncomm, npio, xtime_npio_read, xtime_comm_read, &
182 USE modd_io_surf_fa, ONLY : nunit_fa, nluout, nmask, nfull, nfull_ext, &
183 ndgl, ndlon, ndgux, ndlux, cprefix1d
187 USE modi_error_read_surf_fa
190 USE yomhook
,ONLY : lhook, dr_hook
191 USE parkind1
,ONLY : jprb
201 CHARACTER(LEN=*),
INTENT(IN) :: hrec
202 INTEGER,
INTENT(IN) :: kl
203 REAL,
DIMENSION(:),
INTENT(OUT) :: pfield
204 INTEGER,
INTENT(OUT) :: kresp
205 CHARACTER(LEN=100),
INTENT(OUT) :: hcomment
206 CHARACTER(LEN=1),
INTENT(IN) :: hdir
212 CHARACTER(LEN=4) :: yprefix
213 CHARACTER(LEN=3) :: ypref
216 INTEGER :: i, j, infompi
218 INTEGER,
DIMENSION(MPI_STATUS_SIZE) :: istatus
221 REAL,
DIMENSION(:),
ALLOCATABLE :: zwork2
223 REAL(KIND=JPRB) :: zhook_handle
225 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFX1_FA',0,zhook_handle)
237 IF (nrank==npio)
THEN
241 ALLOCATE(xworkd(nfull))
245 IF (ypref==
'CLS' .OR. ypref==
'SUR' .OR. ypref==
'PRO' .OR. ypref==
'ATM')
THEN
246 ALLOCATE(zwork2(nfull_ext))
247 CALL facile(kresp,nunit_fa,hrec(1:4),0,hrec(5:16),zwork2,.false.)
251 xworkd((j-1)*ndlux + i) = zwork2((j-1)*ndlon + i)
263 CALL facile(nworkb,nunit_fa,yprefix,0,hrec,xworkd,.false.)
265 cwork0 = yprefix//trim(hrec)
270 ELSEIF (hdir/=
'-')
THEN
280 xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
284 IF ( nrank==npio )
THEN
288 pfield(:) = xworkd(1:kl)
290 xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
293 ELSEIF (hdir==
'-')
THEN
298 CALL mpi_bcast(nfull,kind(nfull)/4,mpi_integer,npio,ncomm,infompi)
299 IF ( nrank/=npio )
ALLOCATE(xworkd(nfull))
300 CALL mpi_bcast(xworkd(1:kl),kl*kind(xworkd)/4,mpi_real,npio,ncomm,infompi)
301 xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
305 pfield(:) = xworkd(1:kl)
316 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFX1_FA',1,zhook_handle)
330 USE modd_surfex_mpi, ONLY : nrank, nproc, ncomm, npio, xtime_npio_read, xtime_comm_read, &
337 USE modi_error_read_surf_fa
340 USE yomhook
,ONLY : lhook, dr_hook
341 USE parkind1
,ONLY : jprb
351 CHARACTER(LEN=*),
INTENT(IN) :: hrec
352 INTEGER,
INTENT(IN) :: kl1
353 INTEGER,
INTENT(IN) :: kl2
354 REAL,
DIMENSION(:,:),
INTENT(OUT) :: pfield
355 INTEGER,
INTENT(OUT) :: kresp
356 CHARACTER(LEN=100),
INTENT(OUT) :: hcomment
357 CHARACTER(LEN=1),
INTENT(IN) :: hdir
363 CHARACTER(LEN=4) :: yprefix
364 CHARACTER(LEN=2) :: ypatch
365 CHARACTER(LEN=3) :: ynum
368 INTEGER :: jl, i, infompi
371 INTEGER,
DIMENSION(MPI_STATUS_SIZE) :: istatus
373 REAL,
DIMENSION(:,:),
ALLOCATABLE :: zwork
375 REAL(KIND=JPRB) :: zhook_handle
377 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFX2_FA',0,zhook_handle)
389 IF (nrank==npio)
THEN
393 ALLOCATE(xworkd2(nfull,kl2))
399 WRITE(ynum,
'(I3.3)')jl
400 yprefix=cprefix2d//ynum
402 WRITE(ypatch,
'(I2.2)')jl
403 yprefix=
'S'//ypatch//
'_'
405 CALL facile(nworkb,nunit_fa,yprefix,jl,hrec,xworkd2(:,jl),.false.)
407 cwork0 = yprefix//trim(hrec)
412 cwork0 =
'PATCH_'//trim(hrec)
416 ELSEIF (hdir/=
'-')
THEN
418 ALLOCATE(xworkd2(0,0))
426 xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
430 IF ( nrank==npio )
THEN
434 pfield(:,:) = xworkd2(1:kl1,1:kl2)
436 xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
439 ELSEIF (hdir==
'-')
THEN
444 CALL mpi_bcast(nfull,kind(nfull)/4,mpi_integer,npio,ncomm,infompi)
445 IF ( nrank/=npio )
ALLOCATE(xworkd2(nfull,kl2))
446 CALL mpi_bcast(xworkd2(1:kl1,1:kl2),kl1*kl2*kind(xworkd2)/4,mpi_real,npio,ncomm,infompi)
447 xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
451 pfield(:,:) = xworkd2(1:kl1,1:kl2)
462 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFX2_FA',1,zhook_handle)
470 hrec,kfield,kresp,hcomment)
485 USE modi_error_read_surf_fa
487 USE yomhook
,ONLY : lhook, dr_hook
488 USE parkind1
,ONLY : jprb
496 CHARACTER(LEN=*),
INTENT(IN) :: hrec
497 INTEGER,
INTENT(OUT) :: kfield
498 INTEGER,
INTENT(OUT) :: kresp
499 CHARACTER(LEN=100),
INTENT(OUT) :: hcomment
503 CHARACTER(LEN=50) :: ycomment
504 CHARACTER(LEN=6) :: ymask
505 CHARACTER(LEN=18) :: yname
508 REAL(KIND=JPRB) :: zhook_handle
510 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFN0_FA',0,zhook_handle)
519 yname=cprefix1d//trim(hrec)
522 IF (lwork0) ymask=
'FULL '
523 yname=trim(ymask)//trim(hrec)
526 CALL
falit_i(kresp,nunit_fa,yname,kfield)
531 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFN0_FA',1,zhook_handle)
539 hrec,kl,kfield,kresp,hcomment,hdir)
547 USE modd_surfex_mpi, ONLY : nrank, nproc, ncomm, npio, xtime_npio_read, xtime_comm_read, &
552 USE modd_io_surf_fa, ONLY : nunit_fa, nluout, nmask, nfull, cmask, cprefix1d
557 USE modi_error_read_surf_fa
560 USE yomhook
,ONLY : lhook, dr_hook
561 USE parkind1
,ONLY : jprb
573 CHARACTER(LEN=*),
INTENT(IN) :: hrec
574 INTEGER,
INTENT(IN) :: kl
575 INTEGER,
DIMENSION(:),
INTENT(OUT) :: kfield
576 INTEGER,
INTENT(OUT) :: kresp
577 CHARACTER(LEN=100),
INTENT(OUT) :: hcomment
578 CHARACTER(LEN=1),
INTENT(IN) :: hdir
584 CHARACTER(LEN=6) :: ymask
585 CHARACTER(LEN=18) :: yname
588 INTEGER :: i, infompi
590 INTEGER,
DIMENSION(MPI_STATUS_SIZE) :: istatus
594 REAL(KIND=JPRB) :: zhook_handle
596 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFN1_FA',0,zhook_handle)
612 IF (nrank==npio)
THEN
621 yname=cprefix1d//trim(hrec)
624 IF (lwork0) ymask=
'FULL '
625 yname=trim(ymask)//trim(hrec)
630 ELSEIF (hdir/=
'-')
THEN
631 ALLOCATE(nworkd(nfull))
634 CALL
falit_i_d(nworkb,nunit_fa,yname,
SIZE(nworkd),nworkd)
641 ELSEIF (hdir/=
'-')
THEN
651 xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
655 IF ( nrank==npio )
THEN
659 kfield(:) = nworkd(1:kl)
661 xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
664 ELSEIF (hdir==
'-')
THEN
669 CALL mpi_bcast(nfull,kind(nfull)/4,mpi_integer,npio,ncomm,infompi)
670 IF ( nrank/=npio )
ALLOCATE(nworkd(nfull))
671 CALL mpi_bcast(nworkd(1:kl),kl*kind(nworkd)/4,mpi_integer,npio,ncomm,infompi)
672 xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
676 kfield(:) = nworkd(1:kl)
687 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFN1_FA',1,zhook_handle)
695 hrec,hfield,kresp,hcomment)
710 USE modi_error_read_surf_fa
712 USE yomhook
,ONLY : lhook, dr_hook
713 USE parkind1
,ONLY : jprb
721 CHARACTER(LEN=*),
INTENT(IN) :: hrec
722 CHARACTER(LEN=40),
INTENT(OUT) :: hfield
723 INTEGER,
INTENT(OUT) :: kresp
724 CHARACTER(LEN=100),
INTENT(OUT) :: hcomment
728 CHARACTER(LEN=50) :: ycomment
729 CHARACTER(LEN=6) :: ymask
730 CHARACTER(LEN=18) :: yname
731 CHARACTER,
DIMENSION(40) :: yfield
734 REAL(KIND=JPRB) :: zhook_handle
737 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFC0_FA',0,zhook_handle)
746 yname=cprefix1d//trim(hrec)
749 IF (lwork0) ymask=
'FULL '
750 yname=trim(ymask)//trim(hrec)
753 CALL
falit_c(kresp,nunit_fa,yname,40,yfield)
755 WRITE(hfield,
'(40A1)') yfield(:)
759 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFC0_FA',1,zhook_handle)
766 hrec,ofield,kresp,hcomment)
781 USE modi_error_read_surf_fa
783 USE yomhook
,ONLY : lhook, dr_hook
784 USE parkind1
,ONLY : jprb
792 CHARACTER(LEN=*),
INTENT(IN) :: hrec
793 LOGICAL,
INTENT(OUT) :: ofield
794 INTEGER,
INTENT(OUT) :: kresp
795 CHARACTER(LEN=100),
INTENT(OUT) :: hcomment
799 CHARACTER(LEN=50) :: ycomment
800 CHARACTER(LEN=6) :: ymask
801 CHARACTER(LEN=18) :: yname
804 REAL(KIND=JPRB) :: zhook_handle
806 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFL0_FA',0,zhook_handle)
815 yname=cprefix1d//trim(hrec)
818 IF (lwork0) ymask=
'FULL '
819 yname=trim(ymask)//trim(hrec)
822 CALL
falit_l(kresp,nunit_fa,yname,ofield)
828 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFL0_FA',1,zhook_handle)
835 hrec,kl,ofield,kresp,hcomment,hdir)
845 USE modd_surfex_mpi, ONLY : nrank, nproc, ncomm, npio, xtime_npio_read, xtime_comm_read, &
853 USE modi_error_read_surf_fa
855 USE yomhook
,ONLY : lhook, dr_hook
856 USE parkind1
,ONLY : jprb
868 CHARACTER(LEN=*),
INTENT(IN) :: hrec
869 INTEGER,
INTENT(IN) :: kl
870 LOGICAL,
DIMENSION(:),
INTENT(OUT) :: ofield
871 INTEGER,
INTENT(OUT) :: kresp
872 CHARACTER(LEN=100),
INTENT(OUT) :: hcomment
873 CHARACTER(LEN=1),
INTENT(IN) :: hdir
879 CHARACTER(LEN=6) :: ymask
880 CHARACTER(LEN=18) :: yname
885 REAL(KIND=JPRB) :: zhook_handle
887 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFL1_FA',0,zhook_handle)
899 IF (nrank==npio)
THEN
908 yname=cprefix1d//trim(hrec)
911 IF (lwork0) ymask=
'FULL '
912 yname=trim(ymask)//trim(hrec)
915 CALL
falit_l_d(nworkb,nunit_fa,yname,kl,lworkd)
928 xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
932 IF (nproc>1 .AND. hdir/=
'A')
THEN
935 CALL mpi_bcast(lworkd,kl,mpi_logical,npio,ncomm,infompi)
936 xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
943 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFL1_FA',1,zhook_handle)
951 hrec,kyear,kmonth,kday,ptime,kresp,hcomment)
966 USE modi_error_read_surf_fa
968 USE yomhook
,ONLY : lhook, dr_hook
969 USE parkind1
,ONLY : jprb
977 CHARACTER(LEN=*),
INTENT(IN) :: hrec
978 INTEGER,
INTENT(OUT) :: kyear
979 INTEGER,
INTENT(OUT) :: kmonth
980 INTEGER,
INTENT(OUT) :: kday
981 REAL,
INTENT(OUT) :: ptime
982 INTEGER,
INTENT(OUT) :: kresp
983 CHARACTER(LEN=100),
INTENT(OUT) :: hcomment
987 CHARACTER(LEN=50) :: ycomment
988 CHARACTER(LEN=6) :: ymask
989 CHARACTER(LEN=18) :: yname
992 INTEGER,
DIMENSION(3) :: itdate
993 REAL(KIND=JPRB) :: zhook_handle
995 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFT0_FA',0,zhook_handle)
1004 yname=cprefix1d//trim(hrec)//
'%TDATE'
1007 IF (lwork0) ymask=
'FULL '
1008 yname=trim(ymask)//trim(hrec)//
'%TDATE'
1011 CALL
falit_i_d(kresp,nunit_fa,yname,3,itdate)
1020 yname=cprefix1d//trim(hrec)//
'%TIME'
1023 IF (lwork0) ymask=
'FULL '
1024 yname=trim(ymask)//trim(hrec)//
'%TIME'
1027 CALL
falit_r(kresp,nunit_fa,yname,ptime)
1030 ycomment = trim(hrec)
1033 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFT0_FA',1,zhook_handle)
1041 hrec,kl1,kl2,kyear,kmonth,kday,ptime,kresp,hcomment)
1057 USE modi_error_read_surf_fa
1059 USE yomhook
,ONLY : lhook, dr_hook
1060 USE parkind1
,ONLY : jprb
1068 CHARACTER(LEN=*),
INTENT(IN) :: hrec
1070 INTEGER,
DIMENSION(:,:),
INTENT(OUT) :: kyear
1071 INTEGER,
DIMENSION(:,:),
INTENT(OUT) :: kmonth
1072 INTEGER,
DIMENSION(:,:),
INTENT(OUT) :: kday
1073 REAL,
DIMENSION(:,:),
INTENT(OUT) :: ptime
1074 INTEGER,
INTENT(OUT) :: kresp
1075 CHARACTER(LEN=100),
INTENT(OUT) :: hcomment
1079 CHARACTER(LEN=50) :: ycomment
1080 CHARACTER(LEN=6) :: ymask
1081 CHARACTER(LEN=18) :: yname
1084 INTEGER,
DIMENSION(3,SIZE(KYEAR,1),SIZE(KYEAR,2)) :: itdate
1085 REAL(KIND=JPRB) :: zhook_handle
1087 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFT2_FA',0,zhook_handle)
1103 yname=cprefix1d//trim(hrec)
1106 IF (lwork0) ymask=
'FULL '
1107 yname=trim(ymask)//trim(hrec)
1110 WRITE(nluout,*)
' READ_SURFT2_FA : time in 2 dimensions not yet implemented : YNAME=',yname
1111 CALL
abor1_sfx(
'MODE_READ_SURF_FA:READ_SURFT2_FA: time in 2 dimensions not yet implemented')
1115 IF (lhook) CALL dr_hook(
'MODE_READ_SURF_FA:READ_SURFT2_FA',1,zhook_handle)
subroutine falit_i(KREP, KN, CNOMC, KDATA)
subroutine read_surfl0_fa(HREC, OFIELD, KRESP, HCOMMENT)
subroutine falit_l_d(KREP, KN, CNOMC, KSIZE, LDATA)
subroutine read_surft0_fa(HREC, KYEAR, KMONTH, KDAY, PTIME, KRESP, HCOMMENT)
subroutine read_surfx0_fa(HREC, PFIELD, KRESP, HCOMMENT)
subroutine read_surfx2_fa(HREC, KL1, KL2, PFIELD, KRESP, HCOMMENT, HDIR)
subroutine read_surfc0_fa(HREC, HFIELD, KRESP, HCOMMENT)
subroutine abor1_sfx(YTEXT)
subroutine read_surfl1_fa(HREC, KL, OFIELD, KRESP, HCOMMENT, HDIR)
subroutine error_read_surf_fa(HREC, KRESP)
subroutine read_surfn1_fa(HREC, KL, KFIELD, KRESP, HCOMMENT, HDIR)
subroutine falit_i_d(KREP, KN, CNOMC, KSIZE, KDATA)
subroutine wlog_mpi(HLOG, PLOG, KLOG, KLOG2, OLOG)
subroutine falit_c(KREP, KN, CNOMC, KSIZE, CDATA)
subroutine read_surfx1_fa(HREC, KL, PFIELD, KRESP, HCOMMENT, HDIR)
subroutine io_buff(HREC, HACTION, OKNOWN)
subroutine falit_r(KREP, KN, CNOMC, PDATA)
subroutine read_surft2_fa(HREC, KL1, KL2, KYEAR, KMONTH, KDAY, PTIME, KRESP, HCOMMENT)
subroutine falit_l(KREP, KN, CNOMC, LDATA)
subroutine read_surfn0_fa(HREC, KFIELD, KRESP, HCOMMENT)
subroutine sfx_fa_version(ONEW)