|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE INIT_IO_SURF_LFI_n(HMASK,HACTION) 00003 ! ###################### 00004 ! 00005 !!**** *INIT_IO_SURF_LFI* Keep in memory the output files 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 ! 00010 !! 00011 !!** IMPLICIT ARGUMENTS 00012 !! ------------------ 00013 !! None 00014 !! 00015 !! REFERENCE 00016 !! --------- 00017 !! 00018 !! AUTHOR 00019 !! ------ 00020 !! V. Masson *Meteo France* 00021 !! 00022 !! MODIFICATIONS 00023 !! ------------- 00024 !! 00025 !! P. Le Moigne 04/2004: distinguish in and out file name 00026 !! P. Le Moigne 04/2006: special HACTION='GTMSK' to initialize 00027 !! a mask different of 'FULL ' in order 00028 !! to read dimensions only. 00029 ! 00030 !* 0. DECLARATIONS 00031 ! ------------ 00032 ! 00033 USE MODD_SURFEX_MPI, ONLY : NRANK, NINDEX, NPIO, NSIZE 00034 ! 00035 USE MODD_SURF_PAR, ONLY: NUNDEF 00036 ! 00037 USE MODD_IO_SURF_LFI,ONLY: CFILE_LFI, CFILEIN_LFI,CFILEOUT_LFI, & 00038 NMASK,CLUOUT_LFI,NFULL,CMASK, NLUOUT, & 00039 NFULL_SURF, & 00040 NIB, NIE, NJB, NJE, NIU, NJU, & 00041 NIB_SURF, NIE_SURF, NJB_SURF, NJE_SURF,& 00042 NIU_SURF, NJU_SURF 00043 ! 00044 USE MODI_GET_LUOUT 00045 USE MODI_READ_SURF 00046 USE MODI_GET_DIM_FULL_n 00047 USE MODI_GET_SIZE_FULL_n 00048 USE MODI_GET_TYPE_DIM_n 00049 USE MODI_INIT_IO_SURF_MASK_n 00050 ! 00051 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00052 USE PARKIND1 ,ONLY : JPRB 00053 ! 00054 IMPLICIT NONE 00055 ! 00056 CHARACTER(LEN=6), INTENT(IN) :: HMASK 00057 CHARACTER(LEN=5), INTENT(IN) :: HACTION 00058 ! 00059 INTEGER :: ILU,IRET, IL 00060 INTEGER :: INB ! number of articles in the file 00061 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00062 !------------------------------------------------------------------------------ 00063 IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_LFI_N',0,ZHOOK_HANDLE) 00064 ! 00065 CALL GET_LUOUT('LFI ',NLUOUT) 00066 ! 00067 !$OMP BARRIER 00068 ! 00069 IF (HACTION=='GTMSK') THEN 00070 IF (NRANK==NPIO) THEN 00071 !$OMP SINGLE 00072 CALL FMOPEN(CFILEIN_LFI,'OLD',CLUOUT_LFI,0,1,1,INB,IRET) 00073 !$OMP END SINGLE 00074 CFILE_LFI = CFILEIN_LFI 00075 ENDIF 00076 CMASK = HMASK 00077 IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_LFI_N',1,ZHOOK_HANDLE) 00078 RETURN 00079 ENDIF 00080 ! 00081 IF (HACTION == 'READ ') THEN 00082 IF (NRANK==NPIO) THEN 00083 !$OMP SINGLE 00084 CALL FMOPEN(CFILEIN_LFI,'OLD',CLUOUT_LFI,0,1,1,INB,IRET) 00085 !$OMP END SINGLE 00086 CFILE_LFI = CFILEIN_LFI 00087 ENDIF 00088 CALL READ_SURF('LFI ','DIM_FULL',NFULL,IRET,HDIR='A') 00089 IF (HMASK == 'FULL ') THEN 00090 NFULL_SURF = NFULL 00091 NIB_SURF = NIB 00092 NIE_SURF = NIE 00093 NJB_SURF = NJB 00094 NJE_SURF = NJE 00095 NIU_SURF = NIU 00096 NJU_SURF = NJU 00097 ENDIF 00098 ELSE 00099 CALL GET_DIM_FULL_n(NFULL) 00100 ENDIF 00101 ! 00102 ! 00103 IF (HACTION=='WRITE' .AND. NRANK==NPIO) THEN 00104 !$OMP SINGLE 00105 CALL FMOPEN(CFILEOUT_LFI,'UNKNOWN',CLUOUT_LFI,0,1,1,INB,IRET) 00106 !$OMP END SINGLE 00107 CFILE_LFI = CFILEOUT_LFI 00108 ENDIF 00109 ! 00110 !* initialisation of 2D arrays 00111 ! 00112 IF (NIB_SURF/=NUNDEF) THEN 00113 NIB = NIB_SURF 00114 NIE = NIE_SURF 00115 NJB = NJB_SURF 00116 NJE = NJE_SURF 00117 NIU = NIU_SURF 00118 NJU = NJU_SURF 00119 END IF 00120 ! 00121 ! nindex is needed for call to get_size_full_n. In init_index_mpi, 00122 ! it's not initialized for first readings. 00123 IF (.NOT.ALLOCATED(NINDEX)) THEN 00124 ALLOCATE(NINDEX(NFULL)) 00125 NINDEX(:) = 0 00126 ENDIF 00127 ! 00128 !------------------------------------------------------------------------------ 00129 ! 00130 ! MASK is sized according to the mpi task running 00131 CALL GET_SIZE_FULL_n('LFI ',NFULL,ILU) 00132 IF (ILU>NSIZE) NSIZE = ILU 00133 ! 00134 IL = ILU 00135 CALL GET_TYPE_DIM_n(HMASK,IL) 00136 CALL INIT_IO_SURF_MASK_n(HMASK, IL, NLUOUT, ILU, NMASK) 00137 ! 00138 !------------------------------------------------------------------------------ 00139 CMASK = HMASK 00140 IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_LFI_N',1,ZHOOK_HANDLE) 00141 !------------------------------------------------------------------------------ 00142 ! 00143 END SUBROUTINE INIT_IO_SURF_LFI_n
1.8.0